home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / cg68k.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  232KB  |  6,252 lines
  1. {
  2.     $Id: cg68k.pas,v 1.2.2.9 1998/09/21 19:06:21 carl Exp $
  3.     Copyright (c) 1993,98 by Florian Klaempfl, Carl Eric Codere
  4.  
  5.     This unit generates 68000 (or better) assembler from the parse tree
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ****************************************************************************}
  22. {$ifdef tp}
  23. {$E+,F+,N+,D+,L+,Y+}
  24. {$endif}
  25.  
  26. {---------------------------------------------------------------------------}
  27. { LEFT TO DO IN CG68k AND CG68k2
  28. }
  29.  
  30. {---------------------------------------------------------------------------}
  31. {  o Test and correct problems with extended support.
  32. }
  33. {  o Optimize secondmoddiv when doing a constant modulo.
  34. }
  35. {  o Add emulation support for Cardinal under MC68000.
  36. }
  37.  
  38. {---------------------------------------------------------------------------}
  39.  
  40. unit cg68k;
  41.  
  42. {***************************************************************************}
  43. interface
  44.  
  45. {***************************************************************************}
  46.  
  47. uses    objects,verbose,cobjects,systems,globals,tree,
  48.         symtable,types,strings,pass_1,hcodegen,
  49.         aasm,m68k,tgen68k,files,cga68k,cg68k2,gdb,link;
  50.  
  51. { produces assembler for the expression in variable p }
  52. { and produces an assembler node at the end           }
  53. procedure generatecode(var p : ptree);
  54.  
  55. { produces the actual code }
  56. function do_secondpass(var p : ptree) : boolean;
  57.  
  58. procedure secondpass(var p : ptree);
  59.  
  60. {$ifdef test_dest_loc}
  61. const   { used to avoid temporary assignments }
  62.         dest_loc_known : boolean = false;
  63.         in_dest_loc : boolean = false;
  64.         dest_loc_tree : ptree = nil;
  65.  
  66. var dest_loc : tlocation;
  67.  
  68. procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
  69.  
  70. {$endif test_dest_loc}
  71.  
  72. {***************************************************************************}
  73. implementation
  74.  
  75. {***************************************************************************}
  76.  
  77.     const
  78.        never_copy_const_param : boolean = false;
  79.        bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
  80.         { used to avoid temporary assignments }
  81.         dest_loc_known : boolean = false;
  82.         in_dest_loc : boolean = false;
  83.         dest_loc_tree : ptree = nil;
  84.  
  85.     var
  86.        { this is for open arrays and strings        }
  87.        { but be careful, this data is in the        }
  88.        { generated code destroyed quick, and also   }
  89.        { the next call of secondload destroys this  }
  90.        { data                                       }
  91.        { So be careful using the informations       }
  92.        { provided by this variables                 }
  93.        highframepointer : tregister;
  94.        highoffset : longint;
  95.        dest_loc : tlocation;
  96.  
  97.         procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
  98.  
  99.           begin
  100.              if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER)
  101. then
  102.                begin
  103.                  emit_reg_reg(A_MOVE,s,reg,dest_loc.register);
  104.                  p^.location:=dest_loc;
  105.                  in_dest_loc:=true;
  106.                end
  107.              else
  108.              if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
  109.                begin
  110.  
  111. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,s,reg,newreference(dest_loc.reference))));
  112.                  p^.location:=dest_loc;
  113.                  in_dest_loc:=true;
  114.                end
  115.              else
  116.                internalerror(20080);
  117.           end;
  118.  
  119.     procedure error(const t : tmsgconst);
  120.  
  121.       begin
  122.          if not(codegenerror) then
  123.            verbose.Message(t);
  124.          codegenerror:=true;
  125.       end;
  126.  
  127.     type
  128.        secondpassproc = procedure(var p : ptree);
  129.  
  130.     procedure seconderror(var p : ptree);
  131.  
  132.       begin
  133.          p^.error:=true;
  134.          codegenerror:=true;
  135.       end;
  136.  
  137.     procedure secondload(var p : ptree);
  138.  
  139.       var
  140.          hregister : tregister;
  141.          i : longint;
  142.          symtabletype: tsymtabletype;
  143.          hp : preference;
  144.  
  145.       begin
  146.          simple_loadn:=true;
  147.          reset_reference(p^.location.reference);
  148.          case p^.symtableentry^.typ of
  149.               { this is only for toasm and toaddr }
  150.               absolutesym :
  151.                  begin
  152.                     stringdispose(p^.location.reference.symbol);
  153.  
  154. p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  155.                     if p^.symtableentry^.owner^.symtabletype=unitsymtable
  156. then
  157.  
  158. concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  159.                  end;
  160.               varsym :
  161.                  begin
  162.                     hregister:=R_NO;
  163.                     symtabletype:=p^.symtable^.symtabletype;
  164.                     { in case it is a register variable: }
  165.                     { we simply set the location to the  }
  166.                     { correct register.                  }
  167.                     if pvarsym(p^.symtableentry)^.reg<>R_NO then
  168.                       begin
  169.                          p^.location.loc:=LOC_CREGISTER;
  170.  
  171. p^.location.register:=pvarsym(p^.symtableentry)^.reg;
  172.                          unused:=unused-[pvarsym(p^.symtableentry)^.reg];
  173.                       end
  174.                     else
  175.                       begin
  176.                          { --------------------- LOCAL AND TEMP VARIABLES
  177. ------------- }
  178.                          if (symtabletype=parasymtable) or
  179. (symtabletype=localsymtable) then
  180.                            begin
  181.  
  182. p^.location.reference.base:=procinfo.framepointer;
  183.  
  184. p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
  185.  
  186.                               if (symtabletype=localsymtable) then
  187.  
  188. p^.location.reference.offset:=-p^.location.reference.offset;
  189.  
  190.                               if (symtabletype=parasymtable) then
  191.  
  192. inc(p^.location.reference.offset,p^.symtable^.call_offset);
  193.  
  194.                               if (lexlevel>(p^.symtable^.symtablelevel))
  195. then
  196.                                 begin
  197.                                    hregister:=getaddressreg;
  198.  
  199.                                    { make a reference }
  200.                                    new(hp);
  201.                                    reset_reference(hp^);
  202.                                    hp^.offset:=procinfo.framepointer_offset;
  203.                                    hp^.base:=procinfo.framepointer;
  204.  
  205. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
  206.  
  207.                                    simple_loadn:=false;
  208.                                    i:=lexlevel-1;
  209.                                    while i>(p^.symtable^.symtablelevel) do
  210.                                      begin
  211.                                         { make a reference }
  212.                                         new(hp);
  213.                                         reset_reference(hp^);
  214.                                         hp^.offset:=8;
  215.                                         hp^.base:=hregister;
  216.  
  217. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
  218.                                         dec(i);
  219.                                      end;
  220.                                    p^.location.reference.base:=hregister;
  221.                                 end;
  222.                            end
  223.                          { --------------------- END OF LOCAL AND TEMP VARS
  224. ---------------- }
  225.                          else
  226.                            case symtabletype of
  227.                               unitsymtable,globalsymtable,
  228.                               staticsymtable : begin
  229.  
  230. stringdispose(p^.location.reference.symbol);
  231.  
  232. p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  233.                                                    if
  234. symtabletype=unitsymtable then
  235.  
  236. concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  237.                                                end;
  238.                               objectsymtable : begin
  239.                                                   if
  240. (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
  241.                                                     begin
  242.  
  243. stringdispose(p^.location.reference.symbol);
  244.  
  245. p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  246.                                                         if
  247. p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then
  248.  
  249. concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  250.                                                     end
  251.                                                   else
  252.                                                     begin
  253.  
  254. p^.location.reference.base:=R_A5;
  255.  
  256. p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
  257.                                                end;
  258.                                                end;
  259.                               withsymtable :   begin
  260.                                                   hregister:=getaddressreg;
  261.  
  262. p^.location.reference.base:=hregister;
  263.                                                   { make a reference }
  264.                                                   new(hp);
  265.                                                   reset_reference(hp^);
  266.  
  267. hp^.offset:=p^.symtable^.datasize;
  268.  
  269. hp^.base:=procinfo.framepointer;
  270.  
  271. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
  272.  
  273. p^.location.reference.offset:=
  274.  
  275. pvarsym(p^.symtableentry)^.address;
  276.                                                end;
  277.                            end;
  278.  
  279.                          { in case call by reference, then calculate: }
  280.                          if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
  281.                             ((pvarsym(p^.symtableentry)^.varspez=vs_const)
  282. and
  283.  
  284. dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) then
  285.                            begin
  286.                               simple_loadn:=false;
  287.                               if hregister=R_NO then
  288.                                 hregister:=getaddressreg;
  289.                               { ADDED FOR OPEN ARRAY SUPPORT. }
  290.                               if
  291. (p^.location.reference.base=procinfo.framepointer) then
  292.                                 begin
  293.  
  294. highframepointer:=p^.location.reference.base;
  295.                                    highoffset:=p^.location.reference.offset;
  296.                                 end
  297.                               else
  298.                                 begin
  299.                                    highframepointer:=R_A1;
  300.                                    highoffset:=p^.location.reference.offset;
  301.  
  302. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  303.                                      p^.location.reference.base,R_A1)));
  304.                                 end;
  305.  
  306. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
  307.                                 hregister)));
  308.                               { END ADDITION }
  309.                               clear_reference(p^.location.reference);
  310.                               p^.location.reference.base:=hregister;
  311.                           end;
  312.                          { should be dereferenced later (FK)
  313.                          if
  314. (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
  315.  
  316. ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and
  317. oois_class)<>0) then
  318.                            begin
  319.                               simple_loadn:=false;
  320.                               if hregister=R_NO then
  321.                                 hregister:=getaddressreg;
  322.  
  323. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
  324.                                 hregister)));
  325.                               clear_reference(p^.location.reference);
  326.                               p^.location.reference.base:=hregister;
  327.                            end;
  328.                          }
  329.                       end;
  330.                  end;
  331.               procsym:
  332.                  begin
  333.                     {!!!!! Be aware, work on virtual methods too }
  334.                     stringdispose(p^.location.reference.symbol);
  335.                     p^.location.reference.symbol:=
  336.  
  337. stringdup(pprocsym(p^.symtableentry)^.definition^.mangledname);
  338.                     if p^.symtable^.symtabletype=unitsymtable then
  339.                     concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  340.                  end;
  341.               typedconstsym :
  342.                  begin
  343.                     stringdispose(p^.location.reference.symbol);
  344.  
  345. p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
  346.                     if p^.symtable^.symtabletype=unitsymtable then
  347.                     concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
  348.                  end;
  349.               else internalerror(4);
  350.          end;
  351.       end;
  352.  
  353.     { D0 and D1 used as temp (ok)   }
  354.     procedure secondmoddiv(var p : ptree);
  355.  
  356.       var
  357.          hreg1 : tregister;
  358.          power : longint;
  359.          hl : plabel;
  360.          reg: tregister;
  361.          pushed: boolean;
  362.          hl1: plabel;
  363.       begin
  364.          secondpass(p^.left);
  365.          set_location(p^.location,p^.left^.location);
  366.          pushed:=maybe_push(p^.right^.registers32,p);
  367.          secondpass(p^.right);
  368.          if pushed then restore(p);
  369.  
  370.          { put numerator in register }
  371.          if p^.left^.location.loc<>LOC_REGISTER then
  372.            begin
  373.               if p^.left^.location.loc=LOC_CREGISTER then
  374.                 begin
  375.                   hreg1:=getregister32;
  376.                   emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hreg1);
  377.                 end
  378.               else
  379.                 begin
  380.                   del_reference(p^.left^.location.reference);
  381.                   hreg1:=getregister32;
  382.  
  383. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
  384.                     hreg1)));
  385.                 end;
  386.               p^.left^.location.loc:=LOC_REGISTER;
  387.               p^.left^.location.register:=hreg1;
  388.            end
  389.          else hreg1:=p^.left^.location.register;
  390.  
  391.          if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
  392.             ispowerof2(p^.right^.value,power) then
  393.            begin
  394.               exprasmlist^.concat(new(pai68k, op_reg(A_TST, S_L, hreg1)));
  395.               getlabel(hl);
  396.               emitl(A_BPL,hl);
  397.               if (power = 1) then
  398.                  exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L,1,
  399. hreg1)))
  400.               else
  401.                Begin
  402.                  { optimize using ADDQ if possible!   }
  403.                  if (p^.right^.value-1) < 9 then
  404.                      exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ,
  405. S_L,p^.right^.value-1, hreg1)))
  406.                  else
  407.                      exprasmlist^.concat(new(pai68k, op_const_reg(A_ADD,
  408. S_L,p^.right^.value-1, hreg1)));
  409.                end;
  410.               emitl(A_LABEL, hl);
  411.               if (power > 0) and (power < 9) then
  412.                  exprasmlist^.concat(new(pai68k, op_const_reg(A_ASR,
  413. S_L,power, hreg1)))
  414.               else
  415.                begin
  416.                   exprasmlist^.concat(new(pai68k,
  417. op_const_reg(A_MOVE,S_L,power, R_D0)));
  418.                   exprasmlist^.concat(new(pai68k, op_reg_reg(A_ASR,S_L,R_D0,
  419. hreg1)));
  420.                end;
  421.            end
  422.          else
  423.            begin
  424.               { bring denominator to D1 }
  425.               { D1 is always free, it's }
  426.               { only used for temporary  }
  427.               { purposes                 }
  428.               if (p^.right^.location.loc<>LOC_REGISTER) and
  429.                  (p^.right^.location.loc<>LOC_CREGISTER) then
  430.                  begin
  431.                    del_reference(p^.right^.location.reference);
  432.                    p^.left^.location.loc:=LOC_REGISTER;
  433.  
  434. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),R_D1)));
  435.                 end
  436.              else
  437.               begin
  438.                    ungetregister32(p^.right^.location.register);
  439.  
  440. emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
  441.               end;
  442.  
  443.               { on entering this section D1 should contain the divisor }
  444.  
  445.               if (opt_processors = MC68020) then
  446.               begin
  447.                  { Check if divisor is ZERO - if so call HALT_ERROR }
  448.                  { with d0 = 200 (Division by zero!)                }
  449.                  getlabel(hl1);
  450.                  exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D1)));
  451.                  { if not zero then simply continue on }
  452.                  emitl(A_BNE,hl1);
  453.  
  454. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,200,R_D0)));
  455.                  emitcall('HALT_ERROR',true);
  456.                  emitl(A_LABEL,hl1);
  457.                  if (p^.treetype = modn) then
  458.                  Begin
  459.                    reg := getregister32;
  460.                    exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,reg)));
  461.                    getlabel(hl);
  462.                    { here what we do is prepare the high register with the
  463. }
  464.                    { correct sign. i.e we clear it, check if the low dword
  465. reg }
  466.                    { which will participate in the division is signed, if so
  467. we}
  468.                    { we extend the sign to the high doword register by
  469. inverting }
  470.                    { all the bits.
  471. }
  472.                    exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hreg1)));
  473.                    emitl(A_BPL,hl);
  474.                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,reg)));
  475.                    emitl(A_LABEL,hl);
  476.                    { reg:hreg1 / d1 }
  477.  
  478. exprasmlist^.concat(new(pai68k,op_reg_reg_reg(A_DIVSL,S_L,R_D1,reg,hreg1)));
  479.                    { hreg1 already contains quotient }
  480.                    { looking for remainder }
  481.  
  482. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg,hreg1)));
  483.                    ungetregister32(reg);
  484.                  end
  485.                  else
  486.                  { simple division... }
  487.                  Begin
  488.                    { reg:hreg1 / d1 }
  489.  
  490. exprasmlist^.concat(new(pai68k,op_reg_reg(A_DIVS,S_L,R_D1,hreg1)));
  491.                  end;
  492.               end
  493.               else { MC68000 operations }
  494.                  begin
  495.                      { put numerator in d0 }
  496.                      emit_reg_reg(A_MOVE,S_L,hreg1,R_D0);
  497.                      { operation to perform on entry to both }
  498.                      { routines...  d0/d1                    }
  499.                      { return result in d0                   }
  500.                      if p^.treetype = divn then
  501.                        emitcall('LONGDIV',true)
  502.                      else
  503.                        emitcall('LONGMOD',true);
  504.                      emit_reg_reg(A_MOVE,S_L,R_D0,hreg1);
  505.               end; { endif }
  506.          end;
  507.          { this registers are always used when div/mod are present }
  508.          usedinproc:=usedinproc or ($800 shr word(R_D1));
  509.          usedinproc:=usedinproc or ($800 shr word(R_D0));
  510.          p^.location.loc:=LOC_REGISTER;
  511.          p^.location.register:=hreg1;
  512.       end;
  513.  
  514.     { D6 used as scratch (ok) }
  515.     procedure secondshlshr(var p : ptree);
  516.  
  517.       var
  518.          hregister1,hregister2,hregister3 : tregister;
  519.          op : tasmop;
  520.          pushed : boolean;
  521.       begin
  522.  
  523.          secondpass(p^.left);
  524.          pushed:=maybe_push(p^.right^.registers32,p);
  525.          secondpass(p^.right);
  526.          if pushed then restore(p);
  527.  
  528.          { load left operators in a register }
  529.          if p^.left^.location.loc<>LOC_REGISTER then
  530.            begin
  531.               if p^.left^.location.loc=LOC_CREGISTER then
  532.                 begin
  533.                    hregister1:=getregister32;
  534.                    emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
  535.                      hregister1);
  536.                 end
  537.               else
  538.                 begin
  539.                    del_reference(p^.left^.location.reference);
  540.                    hregister1:=getregister32;
  541.  
  542. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
  543.                      hregister1)));
  544.                 end;
  545.            end
  546.          else hregister1:=p^.left^.location.register;
  547.  
  548.          { determine operator }
  549.          if p^.treetype=shln then
  550.            op:=A_LSL
  551.          else
  552.            op:=A_LSR;
  553.  
  554.          { shifting by a constant directly decode: }
  555.          if (p^.right^.treetype=ordconstn) then
  556.            begin
  557.              if (p^.right^.location.reference.offset and 31 > 0) and
  558. (p^.right^.location.reference.offset and 31 < 9) then
  559.  
  560. exprasmlist^.concat(new(pai68k,op_const_reg(op,S_L,p^.right^.location.reference.offset
  561. and 31,
  562.                    hregister1)))
  563.              else
  564.                begin
  565.  
  566. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,p^.right^.location.reference.offset
  567. and 31,
  568.                    R_D6)));
  569.  
  570. exprasmlist^.concat(new(pai68k,op_reg_reg(op,S_L,R_D6,hregister1)));
  571.                end;
  572.               p^.location.loc:=LOC_REGISTER;
  573.               p^.location.register:=hregister1;
  574.            end
  575.          else
  576.            begin
  577.               { load right operators in a register }
  578.               if p^.right^.location.loc<>LOC_REGISTER then
  579.                 begin
  580.                    if p^.right^.location.loc=LOC_CREGISTER then
  581.                      begin
  582.                         hregister2:=getregister32;
  583.                         emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,
  584.                           hregister2);
  585.                      end
  586.                    else
  587.                      begin
  588.                         del_reference(p^.right^.location.reference);
  589.                         hregister2:=getregister32;
  590.  
  591. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
  592.                           hregister2)));
  593.                      end;
  594.                 end
  595.               else hregister2:=p^.right^.location.register;
  596.  
  597.               emit_reg_reg(op,S_L,hregister2,hregister1);
  598.               p^.location.register:=hregister1;
  599.            end;
  600.          { this register is always used when shl/shr are present }
  601.          usedinproc:=usedinproc or ($800 shr byte(R_D6));
  602.       end;
  603.  
  604.     procedure secondrealconst(var p : ptree);
  605.  
  606.       var
  607.          hp1 : pai;
  608.          lastlabel : plabel;
  609.          found : boolean;
  610.  
  611.       begin
  612.          clear_reference(p^.location.reference);
  613.          lastlabel:=nil;
  614.          found:=false;
  615.          { const already used ? }
  616.          if p^.labnumber=-1 then
  617.            begin
  618.               { tries to found an old entry }
  619.               hp1:=pai(consts^.first);
  620.               while assigned(hp1) do
  621.                 begin
  622.                    if hp1^.typ=ait_label then
  623.                      lastlabel:=pai_label(hp1)^.l
  624.                    else
  625.                      begin
  626.                         if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
  627.                           begin
  628.                              { Florian this caused a internalerror(10)=> no
  629. free reg !! }
  630.                              {if ((p^.realtyp=ait_real_64bit) and
  631. (pai_double(hp1)^.value=p^.valued)) or
  632.                                ((p^.realtyp=ait_real_80bit) and
  633. (pai_extended(hp1)^.value=p^.valued)) or
  634.                                ((p^.realtyp=ait_real_32bit) and
  635. (pai_single(hp1)^.value=p^.valued)) then }
  636.                              if ((p^.realtyp=ait_real_64bit) and
  637. (pai_double(hp1)^.value=p^.valued)) then
  638.                                found:=true;
  639.                              if ((p^.realtyp=ait_real_32bit) and
  640. (pai_single(hp1)^.value=p^.valued)) then
  641.                                found:=true;
  642.                              if ((p^.realtyp=ait_real_extended) and
  643. (pai_extended(hp1)^.value=p^.valued)) then
  644.                                found:=true;
  645.                              if found then
  646.                                begin
  647.                                   { found! }
  648.                                   p^.labnumber:=lastlabel^.nb;
  649.                                   break;
  650.                                end;
  651.                           end;
  652.                         lastlabel:=nil;
  653.                      end;
  654.                    hp1:=pai(hp1^.next);
  655.                 end;
  656.               { :-(, we must generate a new entry }
  657.                  if p^.labnumber=-1 then
  658.                 begin
  659.                    getlabel(lastlabel);
  660.                    p^.labnumber:=lastlabel^.nb;
  661.                    case p^.realtyp of
  662.                      ait_real_64bit :
  663. consts^.insert(new(pai_double,init(p^.valued)));
  664.                      ait_real_32bit :
  665. consts^.insert(new(pai_single,init(p^.valued)));
  666.                      ait_real_extended :
  667. consts^.insert(new(pai_extended,init(p^.valued)));
  668.                      else
  669.                        internalerror(10120);
  670.                      end;
  671.                    consts^.insert(new(pai_label,init(lastlabel)));
  672.                 end;
  673.            end;
  674.          stringdispose(p^.location.reference.symbol);
  675.          p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
  676.       end;
  677.  
  678.     procedure secondfixconst(var p : ptree);
  679.  
  680.       begin
  681.          { an fix comma const. behaves as a memory reference }
  682.          p^.location.loc:=LOC_MEM;
  683.          p^.location.reference.isintvalue:=true;
  684.          p^.location.reference.offset:=p^.valuef;
  685.       end;
  686.  
  687.     procedure secondordconst(var p : ptree);
  688.  
  689.       begin
  690.          { an integer const. behaves as a memory reference }
  691.          p^.location.loc:=LOC_MEM;
  692.          p^.location.reference.isintvalue:=true;
  693.          p^.location.reference.offset:=p^.value;
  694.       end;
  695.  
  696.     procedure secondniln(var p : ptree);
  697.  
  698.       begin
  699.          p^.location.loc:=LOC_MEM;
  700.          p^.location.reference.isintvalue:=true;
  701.          p^.location.reference.offset:=0;
  702.       end;
  703.  
  704.     procedure secondstringconst(var p : ptree);
  705.  
  706.       var
  707.          hp1 : pai;
  708.          lastlabel : plabel;
  709.          pc : pchar;
  710.          same_string : boolean;
  711.          i : word;
  712.  
  713.       begin
  714.          clear_reference(p^.location.reference);
  715.          lastlabel:=nil;
  716.          { const already used ? }
  717.          if p^.labstrnumber=-1 then
  718.            begin
  719.               { tries to found an old entry }
  720.               hp1:=pai(consts^.first);
  721.               while assigned(hp1) do
  722.                 begin
  723.                    if hp1^.typ=ait_label then
  724.                      lastlabel:=pai_label(hp1)^.l
  725.                    else
  726.                      begin
  727.                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
  728.                           (pai_string(hp1)^.len=length(p^.values^)+2) then
  729.                           begin
  730.                              same_string:=true;
  731.                              for i:=1 to length(p^.values^) do
  732.                                if pai_string(hp1)^.str[i]<>p^.values^[i]
  733. then
  734.                                  begin
  735.                                     same_string:=false;
  736.                                     break;
  737.                                  end;
  738.                              if same_string then
  739.                                begin
  740.                                   { found! }
  741.                                   p^.labstrnumber:=lastlabel^.nb;
  742.                                   break;
  743.                                end;
  744.                           end;
  745.                         lastlabel:=nil;
  746.                      end;
  747.                    hp1:=pai(hp1^.next);
  748.                 end;
  749.               { :-(, we must generate a new entry }
  750.               if p^.labstrnumber=-1 then
  751.                 begin
  752.                    getlabel(lastlabel);
  753.                    p^.labstrnumber:=lastlabel^.nb;
  754.                    getmem(pc,length(p^.values^)+3);
  755.                    move(p^.values^,pc^,length(p^.values^)+1);
  756.                    pc[length(p^.values^)+1]:=#0;
  757.                    { we still will have a problem if there is a #0 inside
  758. the pchar }
  759.                    consts^.insert(new(pai_string,init_pchar(pc)));
  760.                    { to overcome this problem we set the length explicitly }
  761.                    { with the ending null char }
  762.                    pai_string(consts^.first)^.len:=length(p^.values^)+2;
  763.                    consts^.insert(new(pai_label,init(lastlabel)));
  764.                 end;
  765.            end;
  766.          stringdispose(p^.location.reference.symbol);
  767.          p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
  768.          p^.location.loc := LOC_MEM;
  769.       end;
  770.  
  771.     procedure secondumminus(var p : ptree);
  772.  
  773.       begin
  774.          secondpass(p^.left);
  775.          p^.location.loc:=LOC_REGISTER;
  776.          case p^.left^.location.loc of
  777.             LOC_REGISTER : begin
  778.  
  779. p^.location.register:=p^.left^.location.register;
  780.  
  781. exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
  782.                            end;
  783.             LOC_CREGISTER : begin
  784.                                p^.location.register:=getregister32;
  785.                                emit_reg_reg(A_MOVE,S_L,p^.location.register,
  786.                                  p^.location.register);
  787.  
  788. exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
  789.                             end;
  790.             LOC_REFERENCE,LOC_MEM :
  791.                            begin
  792.                               del_reference(p^.left^.location.reference);
  793.                               { change sign of a floating point  }
  794.                               { in the case of emulation, get    }
  795.                               { a free register, and change sign }
  796.                               { manually.                        }
  797.                               { otherwise simply load into an FPU}
  798.                               { register.                        }
  799.                               if (p^.left^.resulttype^.deftype=floatdef) and
  800.  
  801. (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
  802.                                 begin
  803.                                    { move to FPU }
  804.  
  805. floatload(pfloatdef(p^.left^.resulttype)^.typ,
  806.  
  807. p^.left^.location.reference,p^.location);
  808.                                    if (cs_fp_emulation) in aktswitches then
  809.                                        { if in emulation mode change sign
  810. manually }
  811.  
  812. exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,
  813.                                           p^.location.fpureg)))
  814.                                    else
  815.  
  816. exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_X,
  817.                                           p^.location.fpureg)));
  818.                                 end
  819.                               else
  820.                                 begin
  821.                                    p^.location.register:=getregister32;
  822.  
  823. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  824.  
  825. newreference(p^.left^.location.reference),
  826.                                      p^.location.register)));
  827.  
  828. exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
  829.                                 end;
  830.                            end;
  831.             LOC_FPU : begin
  832.                               p^.location.loc:=LOC_FPU;
  833.                               p^.location.fpureg :=
  834. p^.left^.location.fpureg;
  835.                               if (cs_fp_emulation) in aktswitches then
  836.  
  837. exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,p^.location.fpureg)))
  838.                               else
  839.  
  840. exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_X,p^.location.fpureg)));
  841.                            end;
  842.          end;
  843. {         emitoverflowcheck;}
  844.       end;
  845.  
  846.     { use of A6 is required only temp (ok) }
  847.     procedure secondaddr(var p : ptree);
  848.  
  849.       begin
  850.          secondpass(p^.left);
  851.          p^.location.loc:=LOC_REGISTER;
  852.          p^.location.register:=getregister32;
  853.          {@ on a procvar means returning an address to the procedure that
  854.           is stored in it.}
  855.        { yes but p^.left^.symtableentry can be nil
  856.        for example on @self !! }
  857.          { symtableentry can be also invalid, if left is no tree node }
  858.          if (p^.left^.treetype=loadn) and
  859.           assigned(p^.left^.symtableentry) and
  860.             (p^.left^.symtableentry^.typ=varsym) and
  861.           (Pvarsym(p^.left^.symtableentry)^.definition^.deftype=
  862.            procvardef) then
  863.             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  864.              newreference(p^.left^.location.reference),
  865.              p^.location.register)))
  866.          else
  867.            begin
  868.             exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  869.              newreference(p^.left^.location.reference),R_A0)));
  870.             exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  871.              R_A0,p^.location.register)));
  872.            end;
  873.          { for use of other segments }
  874.          { if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
  875.              p^.location.segment:=p^.left^.location.reference.segment;
  876.          }
  877.          del_reference(p^.left^.location.reference);
  878.       end;
  879.  
  880.     { register a6 used as scratch }
  881.     procedure seconddoubleaddr(var p : ptree);
  882.  
  883.       begin
  884.          secondpass(p^.left);
  885.          p^.location.loc:=LOC_REGISTER;
  886.          del_reference(p^.left^.location.reference);
  887.          p^.location.register:=getregister32;
  888.          exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  889.           newreference(p^.left^.location.reference),R_A0)));
  890.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  891.           R_A0,p^.location.register)));
  892.       end;
  893.  
  894.     procedure secondnot(var p : ptree);
  895.  
  896.       const
  897.          flagsinvers : array[F_E..F_BE] of tresflags =
  898.             (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
  899.              F_A,F_AE,F_B,F_BE);
  900.  
  901.       var
  902.          hl : plabel;
  903.  
  904.       begin
  905.          if (p^.resulttype^.deftype=orddef) and
  906.             (porddef(p^.resulttype)^.typ=bool8bit) then
  907.               begin
  908.                  case p^.location.loc of
  909.                     LOC_JUMP : begin
  910.                                   hl:=truelabel;
  911.                                   truelabel:=falselabel;
  912.                                   falselabel:=hl;
  913.                                   secondpass(p^.left);
  914.                                   maketojumpbool(p^.left);
  915.                                   hl:=truelabel;
  916.                                   truelabel:=falselabel;
  917.                                   falselabel:=hl;
  918.                                end;
  919.                     LOC_FLAGS : begin
  920.                                    secondpass(p^.left);
  921.  
  922. p^.location.resflags:=flagsinvers[p^.left^.location.resflags];
  923.                                 end;
  924.                     LOC_REGISTER : begin
  925.                                       secondpass(p^.left);
  926.  
  927. p^.location.register:=p^.left^.location.register;
  928.  
  929. exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
  930.                                    end;
  931.                     LOC_CREGISTER : begin
  932.                                        secondpass(p^.left);
  933.                                        p^.location.loc:=LOC_REGISTER;
  934.                                        p^.location.register:=getregister32;
  935.  
  936. emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
  937.                                          p^.location.register);
  938.  
  939. exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
  940.                                     end;
  941.                     LOC_REFERENCE,LOC_MEM : begin
  942.                                               secondpass(p^.left);
  943.  
  944. del_reference(p^.left^.location.reference);
  945.                                               p^.location.loc:=LOC_REGISTER;
  946.  
  947. p^.location.register:=getregister32;
  948.                                               if
  949. p^.left^.location.loc=LOC_CREGISTER then
  950.  
  951. emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
  952.                                                    p^.location.register)
  953.                                               else
  954.  
  955. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
  956.  
  957. newreference(p^.left^.location.reference),
  958.                                                 p^.location.register)));
  959.  
  960. exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
  961.                                            end;
  962.                  end;
  963.               end
  964.             else
  965.               begin
  966.                 secondpass(p^.left);
  967.                 p^.location.loc:=LOC_REGISTER;
  968.  
  969.                 case p^.left^.location.loc of
  970.                    LOC_REGISTER : begin
  971.  
  972. p^.location.register:=p^.left^.location.register;
  973.  
  974. exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
  975.                                   end;
  976.                    LOC_CREGISTER : begin
  977.                                      p^.location.register:=getregister32;
  978.  
  979. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
  980.                                        p^.location.register);
  981.  
  982. exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
  983.                                    end;
  984.                    LOC_REFERENCE,LOC_MEM :
  985.                                   begin
  986.  
  987. del_reference(p^.left^.location.reference);
  988.                                      p^.location.register:=getregister32;
  989.  
  990. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  991.  
  992. newreference(p^.left^.location.reference),
  993.                                        p^.location.register)));
  994.  
  995. exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
  996.                                   end;
  997.                 end;
  998.                 {if  p^.left^.location.loc=loc_register then
  999.                   p^.location.register:=p^.left^.location.register
  1000.                 else
  1001.                   begin
  1002.                      del_locref(p^.left^.location);
  1003.                      p^.location.register:=getregister32;
  1004.                      exprasmlist^.concat(new(pai68k,op_loc_reg(A_MOV,S_L,
  1005.                        p^.left^.location,
  1006.                        p^.location.register)));
  1007.                   end;
  1008.  
  1009. exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));}
  1010.  
  1011.              end;
  1012.       end;
  1013.  
  1014.     procedure secondnothing(var p : ptree);
  1015.  
  1016.       begin
  1017.       end;
  1018.  
  1019.     procedure secondassignment(var p : ptree);
  1020.  
  1021.       var
  1022.          opsize : topsize;
  1023.          withresult : boolean;
  1024.          otlabel,hlabel,oflabel : plabel;
  1025.          hregister : tregister;
  1026.          loc : tloc;
  1027.  
  1028.       begin
  1029.          otlabel:=truelabel;
  1030.          oflabel:=falselabel;
  1031.          getlabel(truelabel);
  1032.          getlabel(falselabel);
  1033.          withresult:=false;
  1034.          { calculate left sides }
  1035.          secondpass(p^.left);
  1036.          case p^.left^.location.loc of
  1037.             LOC_REFERENCE : begin
  1038.                               { in case left operator uses too many
  1039. registers }
  1040.                               { but to few are free then LEA
  1041. }
  1042.                               if (p^.left^.location.reference.base<>R_NO)
  1043. and
  1044.                                  (p^.left^.location.reference.index<>R_NO)
  1045. and
  1046.                                  (usableaddress<p^.right^.registers32) then
  1047.                                 begin
  1048.  
  1049. del_reference(p^.left^.location.reference);
  1050.                                    hregister:=getaddressreg;
  1051.  
  1052. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(
  1053.                                      p^.left^.location.reference),
  1054.                                      hregister)));
  1055.  
  1056. clear_reference(p^.left^.location.reference);
  1057.  
  1058. p^.left^.location.reference.base:=hregister;
  1059.                                    p^.left^.location.reference.index:=R_NO;
  1060.                                 end;
  1061.                               loc:=LOC_REFERENCE;
  1062.                            end;
  1063.             LOC_CREGISTER : loc:=LOC_CREGISTER;
  1064.             else
  1065.                begin
  1066.                   Message(cg_e_illegal_expression);
  1067.                   exit;
  1068.                end;
  1069.          end;
  1070.          { lets try to optimize this (PM)             }
  1071.          { define a dest_loc that is the location      }
  1072.          { and a ptree to verify that it is the right }
  1073.          { place to insert it                         }
  1074. {$ifdef test_dest_loc}
  1075.          if (aktexprlevel<4) then
  1076.            begin
  1077.               dest_loc_known:=true;
  1078.               dest_loc:=p^.left^.location;
  1079.               dest_loc_tree:=p^.right;
  1080.            end;
  1081. {$endif test_dest_loc}
  1082.  
  1083.          if (p^.right^.treetype=realconstn) then
  1084.            begin
  1085.               if p^.left^.resulttype^.deftype=floatdef then
  1086.                 begin
  1087.                    case pfloatdef(p^.left^.resulttype)^.typ of
  1088.                      s32real : p^.right^.realtyp:=ait_real_32bit;
  1089.                      s64real : p^.right^.realtyp:=ait_real_64bit;
  1090.                      s80real : p^.right^.realtyp:=ait_real_extended;
  1091.                      { what about f32bit and s64bit }
  1092.                      end;
  1093.                 end;
  1094.            end;
  1095.          secondpass(p^.right);
  1096. {$ifdef test_dest_loc}
  1097.          dest_loc_known:=false;
  1098.          if in_dest_loc then
  1099.            begin
  1100.               truelabel:=otlabel;
  1101.               falselabel:=oflabel;
  1102.               in_dest_loc:=false;
  1103.               exit;
  1104.            end;
  1105. {$endif test_dest_loc}
  1106.          if p^.left^.resulttype^.deftype=stringdef then
  1107.            begin
  1108.              { we do not need destination anymore }
  1109.              del_reference(p^.left^.location.reference);
  1110.              { only source if withresult is set }
  1111.              if not(withresult) then
  1112.                del_reference(p^.right^.location.reference);
  1113.              loadstring(p);
  1114.              ungetiftemp(p^.right^.location.reference);
  1115.            end
  1116.          else case p^.right^.location.loc of
  1117.             LOC_REFERENCE,
  1118.             LOC_MEM : begin
  1119.                          { handle ordinal constants trimmed }
  1120.                          if (p^.right^.treetype in [ordconstn,fixconstn]) or
  1121.                             (loc=LOC_CREGISTER) then
  1122.                            begin
  1123.                               case p^.left^.resulttype^.size of
  1124.                                  1 : opsize:=S_B;
  1125.                                  2 : opsize:=S_W;
  1126.                                  4 : opsize:=S_L;
  1127.                               end;
  1128.                               if loc=LOC_CREGISTER then
  1129.  
  1130. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
  1131.  
  1132. newreference(p^.right^.location.reference),
  1133.                                   p^.left^.location.register)))
  1134.                               else
  1135.  
  1136. exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,opsize,
  1137.                                   p^.right^.location.reference.offset,
  1138.  
  1139. newreference(p^.left^.location.reference))));
  1140.  
  1141. {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,opsize,
  1142.                                   p^.right^.location.reference.offset,
  1143.                                   p^.left^.location)));}
  1144.                            end
  1145.                          else
  1146.                            begin
  1147.                               concatcopy(p^.right^.location.reference,
  1148.  
  1149. p^.left^.location.reference,p^.left^.resulttype^.size,
  1150.                                 withresult);
  1151.                               ungetiftemp(p^.right^.location.reference);
  1152.                            end;
  1153.                       end;
  1154.             LOC_REGISTER,
  1155.             LOC_CREGISTER : begin
  1156.                               case p^.right^.resulttype^.size of
  1157.                                  1 : opsize:=S_B;
  1158.                                  2 : opsize:=S_W;
  1159.                                  4 : opsize:=S_L;
  1160.                               end;
  1161.                               { simplified with op_reg_loc         }
  1162.                               if loc=LOC_CREGISTER then
  1163.  
  1164. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,opsize,
  1165.                                   p^.right^.location.register,
  1166.                                   p^.left^.location.register)))
  1167.                               else
  1168.  
  1169. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,
  1170.                                   p^.right^.location.register,
  1171.  
  1172. newreference(p^.left^.location.reference))));
  1173.  
  1174. {exprasmlist^.concat(new(pai68k,op_reg_loc(A_MOV,opsize,
  1175.                                   p^.right^.location.register,
  1176.                                   p^.left^.location)));             }
  1177.  
  1178.                            end;
  1179.             LOC_FPU : begin
  1180.                               if loc<>LOC_REFERENCE then
  1181.                                 internalerror(10010)
  1182.                               else
  1183.  
  1184. floatstore(pfloatdef(p^.left^.resulttype)^.typ,
  1185.  
  1186. p^.right^.location,p^.left^.location.reference);
  1187.                       end;
  1188.             LOC_JUMP     : begin
  1189.                               getlabel(hlabel);
  1190.                               emitl(A_LABEL,truelabel);
  1191.                               if loc=LOC_CREGISTER then
  1192.  
  1193. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,
  1194.                                   1,p^.left^.location.register)))
  1195.                               else
  1196.  
  1197. exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
  1198.  
  1199. 1,newreference(p^.left^.location.reference))));
  1200.  
  1201. {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,S_B,
  1202.                                   1,p^.left^.location)));}
  1203.                               emitl(A_JMP,hlabel);
  1204.                               emitl(A_LABEL,falselabel);
  1205.                               if loc=LOC_CREGISTER then
  1206.  
  1207. exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,
  1208.                                   p^.left^.location.register)))
  1209.                               else
  1210.  
  1211. exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
  1212.  
  1213. 0,newreference(p^.left^.location.reference))));
  1214.                               emitl(A_LABEL,hlabel);
  1215.                            end;
  1216.             LOC_FLAGS    : begin
  1217.                               if loc=LOC_CREGISTER then
  1218.                                begin
  1219.  
  1220. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,
  1221.                                   p^.left^.location.register)));
  1222.  
  1223. exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_B,p^.left^.location.register)));
  1224.                                end
  1225.                               else
  1226.                                begin
  1227.  
  1228. exprasmlist^.concat(new(pai68k,op_ref(flag_2_set[p^.right^.location.resflags],S_B,
  1229.  
  1230. newreference(p^.left^.location.reference))));
  1231.  
  1232. exprasmlist^.concat(new(pai68k,op_ref(A_NEG,S_B,newreference(p^.left^.location.reference))));
  1233.                                end;
  1234.  
  1235.                            end;
  1236.          end;
  1237.          truelabel:=otlabel;
  1238.          falselabel:=oflabel;
  1239.       end;
  1240.  
  1241.     procedure secondderef(var p : ptree);
  1242.  
  1243.       var
  1244.          hr : tregister;
  1245.  
  1246.       begin
  1247.          secondpass(p^.left);
  1248.          clear_reference(p^.location.reference);
  1249.          case p^.left^.location.loc of
  1250.             LOC_REGISTER : Begin
  1251.                              hr := getaddressreg;
  1252.  
  1253. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  1254.                              p^.location.reference.base:=hr;
  1255.                              ungetregister(p^.left^.location.register);
  1256.                            end;
  1257.             LOC_CREGISTER : begin
  1258.                                { ... and reserve one for the pointer }
  1259.                                hr:=getaddressreg;
  1260.  
  1261. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  1262.                                       p^.location.reference.base:=hr;
  1263.                                { LOC_REGISTER indicates that this is a
  1264.                                variable register which should not be freed.
  1265. }
  1266. {                               ungetregister(p^.left^.location.register); }
  1267.                             end;
  1268.             else
  1269.               begin
  1270.                  { free register }
  1271.                  del_reference(p^.left^.location.reference);
  1272.  
  1273.                  { ...and reserve one for the pointer }
  1274.                  hr:=getaddressreg;
  1275.                  exprasmlist^.concat(new(pai68k,op_ref_reg(
  1276.                    A_MOVE,S_L,newreference(p^.left^.location.reference),
  1277.                    hr)));
  1278.                  p^.location.reference.base:=hr;
  1279.               end;
  1280.          end;
  1281.       end;
  1282.  
  1283.     { used D0, D1 as scratch (ok) }
  1284.     { arrays ...                  }
  1285.     { Sets up the array and string }
  1286.     { references .                 }
  1287.     procedure secondvecn(var p : ptree);
  1288.  
  1289.       var
  1290.          pushed : boolean;
  1291.          ind : tregister;
  1292.          _p : ptree;
  1293.  
  1294.       procedure calc_emit_mul;
  1295.  
  1296.         var
  1297.            l1,l2 : longint;
  1298.  
  1299.         begin
  1300.            l1:=p^.resulttype^.size;
  1301.            case l1 of
  1302.               1     : p^.location.reference.scalefactor:=l1;
  1303.               2 :
  1304. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,ind)));
  1305.               4 :
  1306. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,ind)));
  1307.               8 :
  1308. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,ind)));
  1309.            else
  1310.              begin
  1311.                if ispowerof2(l1,l2) then
  1312.  
  1313. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,l2,ind)))
  1314.                    else
  1315.                  begin
  1316.                    { use normal MC68000 signed multiply }
  1317.                    if (l1 >= -32768) and (l1 <= 32767) then
  1318.  
  1319. exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_W,l1,ind)))
  1320.                    else
  1321.                    { use long MC68020 long multiply }
  1322.                    if (opt_processors = MC68020) then
  1323.  
  1324. exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,l1,ind)))
  1325.                    else
  1326.                    { MC68000 long multiply }
  1327.                      begin
  1328.  
  1329. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,l1,R_D0)));
  1330.  
  1331. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,ind,R_D1)));
  1332.                        emitcall('LONGMUL',true);
  1333.  
  1334. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,ind)));
  1335.                      end;
  1336.                  end;
  1337.              end; { else case }
  1338.             end; { end case }
  1339.         end; { calc_emit_mul }
  1340.  
  1341.       var
  1342.        extraoffset : longint;
  1343.          t : ptree;
  1344.          hp : preference;
  1345.          tai:pai68k;
  1346.        reg: tregister;
  1347.  
  1348.       begin
  1349.          secondpass(p^.left);
  1350.          { RESULT IS IN p^.location.reference }
  1351.          set_location(p^.location,p^.left^.location);
  1352.  
  1353.          { offset can only differ from 0 if arraydef }
  1354.          if p^.left^.resulttype^.deftype=arraydef then
  1355.            dec(p^.location.reference.offset,
  1356.              p^.resulttype^.size*
  1357.              parraydef(p^.left^.resulttype)^.lowrange);
  1358.  
  1359.          if p^.right^.treetype=ordconstn then
  1360.            begin
  1361.               { offset can only differ from 0 if arraydef }
  1362.               if (p^.left^.resulttype^.deftype=arraydef) then
  1363.               begin
  1364.                    if not(is_open_array(p^.left^.resulttype)) then
  1365.                        begin
  1366.                      if
  1367. (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
  1368.  
  1369. (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
  1370.                         Message(parser_e_range_check_error);
  1371.  
  1372.                      dec(p^.left^.location.reference.offset,
  1373.  
  1374. p^.resulttype^.size*parraydef(p^.left^.resulttype)^.lowrange);
  1375.                     end
  1376.                    else
  1377.                      begin
  1378.                         { range checking for open arrays }
  1379.                      end;
  1380.                   end;
  1381.               inc(p^.left^.location.reference.offset,
  1382.                  p^.right^.value*p^.resulttype^.size);
  1383.               p^.left^.resulttype:=p^.resulttype;
  1384.               disposetree(p^.right);
  1385.               _p:=p^.left;
  1386.               putnode(p);
  1387.               p:=_p;
  1388.            end
  1389.          else
  1390.            begin
  1391.               { quick hack, to overcome Delphi 2 }
  1392.               if (cs_maxoptimieren in aktswitches) and
  1393.                 (p^.left^.resulttype^.deftype=arraydef) then
  1394.                 begin
  1395.                    extraoffset:=0;
  1396.                    if (p^.right^.treetype=addn) then
  1397.                      begin
  1398.                         if p^.right^.right^.treetype=ordconstn then
  1399.                           begin
  1400.                              extraoffset:=p^.right^.right^.value;
  1401.                              t:=p^.right^.left;
  1402.                              putnode(p^.right);
  1403.                              putnode(p^.right^.right);
  1404.                              p^.right:=t
  1405.                           end
  1406.                         else if p^.right^.left^.treetype=ordconstn then
  1407.                           begin
  1408.                              extraoffset:=p^.right^.left^.value;
  1409.                              t:=p^.right^.right;
  1410.                                     putnode(p^.right);
  1411.                              putnode(p^.right^.left);
  1412.                              p^.right:=t
  1413.                           end;
  1414.                      end
  1415.                    else if (p^.right^.treetype=subn) then
  1416.                      begin
  1417.                               if p^.right^.right^.treetype=ordconstn then
  1418.                           begin
  1419.                              extraoffset:=p^.right^.right^.value;
  1420.                              t:=p^.right^.left;
  1421.                              putnode(p^.right);
  1422.                              putnode(p^.right^.right);
  1423.                              p^.right:=t
  1424.                           end
  1425.                         else if p^.right^.left^.treetype=ordconstn then
  1426.                           begin
  1427.                              extraoffset:=p^.right^.left^.value;
  1428.                                     t:=p^.right^.right;
  1429.                              putnode(p^.right);
  1430.                              putnode(p^.right^.left);
  1431.                              p^.right:=t
  1432.                           end;
  1433.                      end;
  1434.                    inc(p^.location.reference.offset,
  1435.                      p^.resulttype^.size*extraoffset);
  1436.                 end;
  1437.               { calculate from left to right }
  1438.               if (p^.location.loc<>LOC_REFERENCE) and
  1439.                  (p^.location.loc<>LOC_MEM) then
  1440.                 Message(cg_e_illegal_expression);
  1441.  
  1442.               pushed:=maybe_push(p^.right^.registers32,p);
  1443.               secondpass(p^.right);
  1444.               if pushed then restore(p);
  1445.                  case p^.right^.location.loc of
  1446.                 LOC_REGISTER : begin
  1447.                                  ind:=p^.right^.location.register;
  1448.                                  case p^.right^.resulttype^.size of
  1449.                                  1:
  1450. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1451.                                       $ff,ind)));
  1452.                                  2:
  1453. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1454.                                       $ffff,ind)));
  1455.                                  end;
  1456.                                end;
  1457.  
  1458.                 LOC_CREGISTER : begin
  1459.                                        ind:=getregister32;
  1460.  
  1461. emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,ind);
  1462.                                    case p^.right^.resulttype^.size of
  1463.                                    1:
  1464. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1465.                                       $ff,ind)));
  1466.                                    2:
  1467. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1468.                                       $ffff,ind)));
  1469.                                 end;
  1470.                                 end;
  1471.                    LOC_FLAGS:
  1472.                      begin
  1473.                         ind:=getregister32;
  1474.  
  1475. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,ind)));
  1476.  
  1477. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,ind)));
  1478.                      end
  1479.                 else { else outer case }
  1480.                    begin
  1481.                       del_reference(p^.right^.location.reference);
  1482.                            ind:=getregister32;
  1483.  
  1484.                       exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  1485.                         newreference(p^.right^.location.reference),ind)));
  1486.  
  1487.                            {Booleans are stored in an 8 bit memory location,
  1488. so
  1489.                            the use of MOVL is not correct.}
  1490.                       case p^.right^.resulttype^.size of
  1491.                         1:
  1492. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1493.                           $ff,ind)));
  1494.                         2:
  1495. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  1496.                           $ffff,ind)));
  1497.                       end; { end case }
  1498.                       end; { end else begin }
  1499.               end;
  1500.  
  1501.               { produce possible range check code: }
  1502.               if cs_rangechecking in aktswitches  then
  1503.                 begin
  1504.                    if p^.left^.resulttype^.deftype=arraydef then
  1505.                      begin
  1506.                         new(hp);
  1507.                         reset_reference(hp^);
  1508.                         parraydef(p^.left^.resulttype)^.genrangecheck;
  1509.  
  1510. hp^.symbol:=stringdup('R_'+tostr(parraydef(p^.left^.resulttype)^.rangenr));
  1511.                         emit_bounds_check(hp^,ind);
  1512.                      end;
  1513.                 end;
  1514.  
  1515.            { ------------------------ HANDLE INDEXING
  1516. ----------------------- }
  1517.            { In Motorola 680x0 mode, displacement can only be of 64K max.
  1518. }
  1519.            { Therefore instead of doing a direct displacement, we must first
  1520. }
  1521.            { load the new address into an address register. Therefore the
  1522. }
  1523.            { symbol is not used.
  1524. }
  1525.            if assigned(p^.location.reference.symbol) then
  1526.            begin
  1527.               if p^.location.reference.base <> R_NO then
  1528.                Message(cg_f_secondvecn_base_defined_twice);
  1529.               p^.location.reference.base:=getaddressreg;
  1530.  
  1531. exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,S_L,newcsymbol(p^.location.reference.symbol^,0),
  1532.                 p^.location.reference.base)));
  1533.               stringdispose(p^.location.reference.symbol);
  1534.            end;
  1535.  
  1536.               if (p^.location.reference.index=R_NO) then
  1537.                 begin
  1538.                    p^.location.reference.index:=ind;
  1539.                    calc_emit_mul;
  1540.                { here we must check for the offset      }
  1541.                { and if out of bounds for the motorola  }
  1542.                { eg: out of signed d8 then reload index }
  1543.                { with correct value.                    }
  1544.                if p^.location.reference.offset > 127 then
  1545.                begin
  1546.  
  1547. exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,p^.location.reference.offset,ind)));
  1548.                   p^.location.reference.offset := 0;
  1549.                end
  1550.                else
  1551.                if p^.location.reference.offset < -128 then
  1552.                begin
  1553.  
  1554. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,S_L,-p^.location.reference.offset,ind)));
  1555.                   p^.location.reference.offset := 0;
  1556.                end;
  1557.                 end
  1558.               else
  1559.                 begin
  1560.                    if p^.location.reference.base=R_NO then
  1561.                       begin
  1562.                           case p^.location.reference.scalefactor of
  1563.                        2 :
  1564. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,p^.location.reference.index)));
  1565.                        4 :
  1566. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,p^.location.reference.index)));
  1567.                        8 :
  1568. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,p^.location.reference.index)));
  1569.                        end;
  1570.                           calc_emit_mul;
  1571.  
  1572.                     { we must use address register to put index in base }
  1573.                     { compare with cgi386.pas                           }
  1574.  
  1575.                     reg := getaddressreg;
  1576.                     p^.location.reference.base := reg;
  1577.  
  1578. emit_reg_reg(A_MOVE,S_L,p^.location.reference.index,reg);
  1579.                     ungetregister(p^.location.reference.index);
  1580.  
  1581.                     p^.location.reference.index:=ind;
  1582.                  end
  1583.                else
  1584.                  begin
  1585.                     reg := getaddressreg;
  1586.                     exprasmlist^.concat(new(pai68k,op_ref_reg(
  1587.                       A_LEA,S_L,newreference(p^.location.reference),
  1588.                       reg)));
  1589.  
  1590.                     ungetregister(p^.location.reference.base);
  1591.                     { the symbol offset is loaded,               }
  1592.                     { so release the symbol name and set symbol  }
  1593.                     { to nil                                     }
  1594.                     stringdispose(p^.location.reference.symbol);
  1595.                     p^.location.reference.offset:=0;
  1596.                     calc_emit_mul;
  1597.                     p^.location.reference.base:=reg;
  1598.                     ungetregister32(p^.location.reference.index);
  1599.                     p^.location.reference.index:=ind;
  1600.                  end;
  1601.                end;
  1602.            end;
  1603.       end;
  1604.  
  1605.     { *************** Converting Types **************** }
  1606.  
  1607.     { produces if necessary rangecheckcode }
  1608.  
  1609.     procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
  1610.  
  1611.       var
  1612.          hp : preference;
  1613.        hregister : tregister;
  1614.        neglabel,poslabel : plabel;
  1615.  
  1616.       begin
  1617.          { convert from p2 to p1 }
  1618.          { range check from enums is not made yet !!}
  1619.          { and its probably not easy }
  1620.          if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
  1621.            exit;
  1622.            { range checking is different for u32bit }
  1623.            { lets try to generate it allways }
  1624.            if (cs_rangechecking in aktswitches)  and
  1625.              { with $R+ explicit type conversations in TP aren't range
  1626. checked! }
  1627.              (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
  1628.              ((porddef(p1)^.von>porddef(p2)^.von) or
  1629.              (porddef(p1)^.bis<porddef(p2)^.bis) or
  1630.              (porddef(p1)^.typ=u32bit) or
  1631.              (porddef(p2)^.typ=u32bit)) then
  1632.            begin
  1633.               porddef(p1)^.genrangecheck;
  1634.               if porddef(p2)^.typ=u8bit then
  1635.                 begin
  1636.                    if (p^.location.loc=LOC_REGISTER) or
  1637.                       (p^.location.loc=LOC_CREGISTER) then
  1638.                      begin
  1639.  
  1640. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
  1641.  
  1642. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
  1643.                      end
  1644.                    else
  1645.                      begin
  1646.  
  1647. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
  1648.  
  1649. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
  1650.                      end;
  1651.                    hregister:=R_D6;
  1652.                 end
  1653.               else if porddef(p2)^.typ=s8bit then
  1654.                 begin
  1655.                    if (p^.location.loc=LOC_REGISTER) or
  1656.                       (p^.location.loc=LOC_CREGISTER) then
  1657.                      begin
  1658.  
  1659. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
  1660.                          { byte to long }
  1661.                          if opt_processors = MC68020 then
  1662.  
  1663. exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
  1664.                          else
  1665.                            begin
  1666.  
  1667. exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
  1668.  
  1669. exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
  1670.                            end;
  1671.                      end
  1672.                    else
  1673.                      begin
  1674.  
  1675. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
  1676.                          { byte to long }
  1677.                          if opt_processors = MC68020 then
  1678.  
  1679. exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
  1680.                          else
  1681.                            begin
  1682.  
  1683. exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
  1684.  
  1685. exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
  1686.                            end;
  1687.                      end; { end outermost else }
  1688.                    hregister:=R_D6;
  1689.                 end
  1690.                { rangechecking for u32bit ?? !!!!!!}
  1691.                { lets try }
  1692.                else if (porddef(p2)^.typ=s32bit) or
  1693. (porddef(p2)^.typ=u32bit)  then
  1694.                 begin
  1695.                    if (p^.location.loc=LOC_REGISTER) or
  1696.                       (p^.location.loc=LOC_CREGISTER) then
  1697.                      hregister:=p^.location.register
  1698.                    else
  1699.                      begin
  1700.  
  1701. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),R_D6)));
  1702.                         hregister:=R_D6;
  1703.                      end;
  1704.                 end
  1705.               { rangechecking for u32bit ?? !!!!!!}
  1706.               else if porddef(p2)^.typ=u16bit then
  1707.                 begin
  1708.                    if (p^.location.loc=LOC_REGISTER) or
  1709.                       (p^.location.loc=LOC_CREGISTER) then
  1710.  
  1711. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
  1712.                    else
  1713.  
  1714. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
  1715.                    { unisgned extend }
  1716.  
  1717. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FFFF,R_D6)));
  1718.                    hregister:=R_D6;
  1719.                 end
  1720.               else if porddef(p2)^.typ=s16bit then
  1721.                 begin
  1722.                    if (p^.location.loc=LOC_REGISTER) or
  1723.                       (p^.location.loc=LOC_CREGISTER) then
  1724.  
  1725. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
  1726.                    else
  1727.  
  1728. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
  1729.                    { sign extend }
  1730.                    exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
  1731.                    hregister:=R_D6;
  1732.                 end
  1733.               else internalerror(6);
  1734.               new(hp);
  1735.               reset_reference(hp^);
  1736.               hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
  1737.               if porddef(p1)^.von>porddef(p1)^.bis then
  1738.                 begin
  1739.                    getlabel(neglabel);
  1740.                    getlabel(poslabel);
  1741.  
  1742. exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hregister)));
  1743.                    emitl(A_BLT,neglabel);
  1744.                 end;
  1745.               emit_bounds_check(hp^,hregister);
  1746.               if porddef(p1)^.von>porddef(p1)^.bis then
  1747.                 begin
  1748.                    new(hp);
  1749.                    reset_reference(hp^);
  1750.  
  1751. hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr+1));
  1752.                    emitl(A_JMP,poslabel);
  1753.                    emitl(A_LABEL,neglabel);
  1754.                    emit_bounds_check(hp^,hregister);
  1755.                    emitl(A_LABEL,poslabel);
  1756.                 end;
  1757.            end;
  1758.       end;
  1759.  
  1760.     type
  1761.        tsecondconvproc = procedure(p,hp : ptree;convtyp : tconverttype);
  1762.  
  1763.      procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
  1764.  
  1765.        begin
  1766.        end;
  1767.  
  1768.     procedure second_only_rangecheck(p,hp : ptree;convtyp : tconverttype);
  1769.  
  1770.       begin
  1771.          maybe_rangechecking(p,hp^.resulttype,p^.resulttype);
  1772.       end;
  1773.  
  1774.     procedure second_bigger(p,hp : ptree;convtyp : tconverttype);
  1775.  
  1776.       var
  1777.          hregister : tregister;
  1778.          opsize : topsize;
  1779.          op : tasmop;
  1780.          is_register : boolean;
  1781.  
  1782.       begin
  1783.          is_register:=p^.left^.location.loc=LOC_REGISTER;
  1784.            if not(is_register) and (p^.left^.location.loc<>LOC_CREGISTER)
  1785. then
  1786.              begin
  1787.                 del_reference(p^.left^.location.reference);
  1788.                 { we can do this here as we need no temp inside
  1789. second_bigger }
  1790.                 ungetiftemp(p^.left^.location.reference);
  1791.              end;
  1792.          { this is wrong !!!
  1793.          gives me movl (%eax),%eax
  1794.          for the length(string !!!
  1795.          use only for constant values }
  1796.          {Constanst cannot be loaded into registers using MOVZX!}
  1797.          if (p^.left^.location.loc<>LOC_MEM) or (not
  1798. p^.left^.location.reference.isintvalue) then
  1799.              case convtyp of
  1800.                      tc_u8bit_2_s32bit,
  1801.                 tc_u8bit_2_u32bit,
  1802.                 tc_s8bit_2_u32bit,
  1803.                 tc_s8bit_2_s16bit,
  1804.                 tc_s8bit_2_s32bit,
  1805.                 tc_u8bit_2_u16bit,
  1806.                 tc_s8bit_2_u16bit,
  1807.                 tc_u8bit_2_s16bit: begin
  1808.                                     if is_register then
  1809.                                       hregister :=
  1810. p^.left^.location.register
  1811.                                     else
  1812.                                       hregister := getregister32;
  1813.                                     if is_register then
  1814.  
  1815. emit_reg_reg(A_MOVE,S_B,p^.left^.location.register, hregister)
  1816.                                     else
  1817.                                     begin
  1818.                                       if p^.left^.location.loc =
  1819. LOC_CREGISTER then
  1820.  
  1821. emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,hregister)
  1822.                                       else
  1823.                                         exprasmlist^.concat(new(pai68k,
  1824. op_ref_reg(A_MOVE,S_B,
  1825.  
  1826. newreference(P^.left^.location.reference), hregister)));
  1827.                                     end;
  1828.  
  1829.                                     case convtyp of
  1830.                                       tc_u8bit_2_s32bit,
  1831.                                       tc_u8bit_2_u32bit:
  1832.  
  1833. exprasmlist^.concat(new(pai68k, op_const_reg(
  1834.  
  1835. A_AND,S_L,$FF,hregister)));
  1836.                                       tc_s8bit_2_u32bit,
  1837.                                       tc_s8bit_2_s32bit:
  1838.                                                   begin
  1839.                                                     if opt_processors =
  1840. MC68020 then
  1841.  
  1842. exprasmlist^.concat(new(pai68k,op_reg
  1843.  
  1844. (A_EXTB,S_L,hregister)))
  1845.                                                     else { else if
  1846. opt_processors }
  1847.                                                     begin
  1848.                                                     { byte to word }
  1849.  
  1850. exprasmlist^.concat(new(pai68k,op_reg
  1851.  
  1852. (A_EXT,S_W,hregister)));
  1853.                                                     { word to long }
  1854.  
  1855. exprasmlist^.concat(new(pai68k,op_reg
  1856.  
  1857. (A_EXT,S_L,hregister)));
  1858.                                                     end;
  1859.                                                   end;
  1860.                                       tc_s8bit_2_u16bit,
  1861.                                       tc_u8bit_2_s16bit,
  1862.                                       tc_u8bit_2_u16bit:
  1863.  
  1864. exprasmlist^.concat(new(pai68k, op_const_reg(
  1865.  
  1866. A_AND,S_W,$FF,hregister)));
  1867.  
  1868.                                       tc_s8bit_2_s16bit:
  1869.  
  1870. exprasmlist^.concat(new(pai68k, op_reg(
  1871.                                                                 A_EXT, S_W,
  1872. hregister)));
  1873.  
  1874.                                     end; { inner case }
  1875.                                    end;
  1876.                 tc_u16bit_2_u32bit,
  1877.                 tc_u16bit_2_s32bit,
  1878.                 tc_s16bit_2_u32bit,
  1879.                 tc_s16bit_2_s32bit: begin
  1880.                                      if is_register then
  1881.                                        hregister :=
  1882. p^.left^.location.register
  1883.                                      else
  1884.                                        hregister := getregister32;
  1885.                                      if is_register then
  1886.  
  1887. emit_reg_reg(A_MOVE,S_W,p^.left^.location.register, hregister)
  1888.                                      else
  1889.                                      begin
  1890.                                        if p^.left^.location.loc =
  1891. LOC_CREGISTER then
  1892.  
  1893. emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,hregister)
  1894.                                        else
  1895.                                          exprasmlist^.concat(new(pai68k,
  1896. op_ref_reg(A_MOVE,S_W,
  1897.  
  1898. newreference(P^.left^.location.reference), hregister)));
  1899.                                      end;
  1900.                                      if (convtyp = tc_u16bit_2_s32bit) or
  1901.                                         (convtyp = tc_u16bit_2_u32bit) then
  1902.                                          exprasmlist^.concat(new(pai68k,
  1903. op_const_reg(
  1904.                                            A_AND, S_L, $ffff, hregister)))
  1905.                                      else { tc_s16bit_2_s32bit }
  1906.                                           { tc_s16bit_2_u32bit }
  1907.                                          exprasmlist^.concat(new(pai68k,
  1908. op_reg(A_EXT,S_L,
  1909.                                            hregister)));
  1910.                                     end;
  1911.              end { end case }
  1912.          else
  1913.          begin
  1914.              case convtyp of
  1915.                 tc_u8bit_2_s32bit,
  1916.                 tc_s8bit_2_s32bit,
  1917.                 tc_u16bit_2_s32bit,
  1918.                 tc_s16bit_2_s32bit,
  1919.             tc_u8bit_2_u32bit,
  1920.             tc_s8bit_2_u32bit,
  1921.             tc_u16bit_2_u32bit,
  1922.             tc_s16bit_2_u32bit:
  1923.  
  1924.                     begin
  1925.                         hregister:=getregister32;
  1926.                         op:=A_MOVE;
  1927.                         opsize:=S_L;
  1928.                     end;
  1929.                 tc_s8bit_2_u16bit,
  1930.                 tc_s8bit_2_s16bit,
  1931.                 tc_u8bit_2_s16bit,
  1932.                 tc_u8bit_2_u16bit:
  1933.                     begin
  1934.                         hregister:=getregister32;
  1935.                         op:=A_MOVE;
  1936.                         opsize:=S_W;
  1937.                     end;
  1938.              end;
  1939.             if is_register then
  1940.               begin
  1941.  
  1942. emit_reg_reg(op,opsize,p^.left^.location.register,hregister);
  1943.               end
  1944.             else
  1945.               begin
  1946.                  if p^.left^.location.loc=LOC_CREGISTER then
  1947.  
  1948. emit_reg_reg(op,opsize,p^.left^.location.register,hregister)
  1949.                  else exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,
  1950.                      newreference(p^.left^.location.reference),hregister)));
  1951.               end;
  1952.          end; { end elseif }
  1953.  
  1954.          p^.location.loc:=LOC_REGISTER;
  1955.          p^.location.register:=hregister;
  1956.          maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
  1957.       end;
  1958.  
  1959.     procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
  1960.  
  1961.       var
  1962.          pushedregs : tpushed;
  1963.  
  1964.       begin
  1965.          stringdispose(p^.location.reference.symbol);
  1966.          gettempofsizereference(p^.resulttype^.size,p^.location.reference);
  1967.          del_reference(p^.left^.location.reference);
  1968.  
  1969. copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
  1970.          ungetiftemp(p^.left^.location.reference);
  1971.       end;
  1972.  
  1973.     procedure second_cstring_charpointer(p,hp : ptree;convtyp :
  1974. tconverttype);
  1975.  
  1976.       begin
  1977.          p^.location.loc:=LOC_REGISTER;
  1978.          p^.location.register:=getregister32;
  1979.          inc(p^.left^.location.reference.offset);
  1980.  
  1981. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  1982.            R_A0)));
  1983.          emit_reg_reg(A_MOVE, S_L, R_A0, p^.location.register);
  1984.       end;
  1985.  
  1986.     procedure second_cchar_charpointer(p,hp : ptree;convtyp : tconverttype);
  1987.  
  1988.       begin
  1989.          {!!!!}
  1990.          p^.location.loc:=LOC_REGISTER;
  1991.          p^.location.register:=getregister32;
  1992.          inc(p^.left^.location.reference.offset);
  1993.  
  1994. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  1995.            R_A0)));
  1996.          emit_reg_reg(A_MOVE, S_L, R_A0, p^.location.register);
  1997.       end;
  1998.  
  1999.     procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
  2000.  
  2001.       begin
  2002.          inc(p^.location.reference.offset);
  2003.       end;
  2004.  
  2005.     procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
  2006.  
  2007.       begin
  2008.          del_reference(p^.left^.location.reference);
  2009.          p^.location.loc:=LOC_REGISTER;
  2010.          p^.location.register:=getregister32;
  2011.  
  2012. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
  2013.            R_A0)));
  2014.          emit_reg_reg(A_MOVE,S_L,R_A0, P^.location.register);
  2015.       end;
  2016.  
  2017.     procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
  2018.  
  2019.       var
  2020.        reg: tregister;
  2021.       begin
  2022.          p^.location.loc:=LOC_REFERENCE;
  2023.          clear_reference(p^.location.reference);
  2024.          { here, after doing some arithmetic on the pointer }
  2025.          { we put it back in an address register            }
  2026.          if p^.left^.location.loc=LOC_REGISTER then
  2027.          begin
  2028.            reg := getaddressreg;
  2029.            { move the pointer in a data register back into }
  2030.            { an address register.                          }
  2031.            emit_reg_reg(A_MOVE, S_L, p^.left^.location.register,reg);
  2032.  
  2033.            p^.location.reference.base:=reg;
  2034.            ungetregister32(p^.left^.location.register);
  2035.          end
  2036.          else
  2037.            begin
  2038.               if p^.left^.location.loc=LOC_CREGISTER then
  2039.                 begin
  2040.                    p^.location.reference.base:=getaddressreg;
  2041.                    emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
  2042.                      p^.location.reference.base);
  2043.                 end
  2044.               else
  2045.                 begin
  2046.                    del_reference(p^.left^.location.reference);
  2047.                    p^.location.reference.base:=getaddressreg;
  2048.  
  2049. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
  2050.                      p^.location.reference.base)));
  2051.                 end;
  2052.            end;
  2053.       end;
  2054.  
  2055.     { generates the code for the type conversion from an array of char }
  2056.     { to a string                                                        }
  2057.     procedure second_chararray_to_string(p,hp : ptree;convtyp :
  2058. tconverttype);
  2059.  
  2060.       var
  2061.          l : longint;
  2062.  
  2063.       begin
  2064.          { this is a type conversion which copies the data, so we can't }
  2065.          { return a reference                                             }
  2066.          p^.location.loc:=LOC_MEM;
  2067.  
  2068.          { first get the memory for the string }
  2069.          stringdispose(p^.location.reference.symbol);
  2070.          gettempofsizereference(256,p^.location.reference);
  2071.  
  2072.          { calc the length of the array }
  2073.          l:=parraydef(p^.left^.resulttype)^.highrange-
  2074.            parraydef(p^.left^.resulttype)^.lowrange+1;
  2075.  
  2076.          if l>255 then
  2077.            Message(sym_e_type_mismatch);
  2078.  
  2079.          { write the length }
  2080.            exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,l,
  2081.              newreference(p^.location.reference))));
  2082.  
  2083.          { copy to first char of string }
  2084.          inc(p^.location.reference.offset);
  2085.  
  2086.          { generates the copy code      }
  2087.          { and we need the source never }
  2088.  
  2089. concatcopy(p^.left^.location.reference,p^.location.reference,l,true);
  2090.  
  2091.          { correct the string location }
  2092.          dec(p^.location.reference.offset);
  2093.       end;
  2094.  
  2095. (*    procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
  2096.  
  2097.       begin
  2098.          stringdispose(p^.location.reference.symbol);
  2099.          gettempofsizereference(256,p^.location.reference);
  2100.          { is it a char const ? }
  2101.          if p^.left^.treetype=ordconstn then
  2102.  
  2103. exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_W,p^.left^.value*256+1,newreference(p^.location.reference))))
  2104.          else
  2105.            begin
  2106.               { not so elegant (goes better with extra register     }
  2107.               { Here the conversion is done in one shot             }
  2108.               { i.e we convert to a string with a single word which }
  2109.               { will be stored, the length followed by the char     }
  2110.               { This is of course, endian specific.                 }
  2111.               if (p^.left^.location.loc=LOC_REGISTER) or
  2112.                  (p^.left^.location.loc=LOC_CREGISTER) then
  2113.                 begin
  2114.  
  2115. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.left^.location.register,R_D6)));
  2116.                    exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W,
  2117. $FF, R_D6)));
  2118.                    ungetregister32(p^.left^.location.register);
  2119.                 end
  2120.               else
  2121.                 begin
  2122.  
  2123. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.left^.location.reference),R_D6)));
  2124.                    exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W,
  2125. $FF, R_D6)));
  2126.                    del_reference(p^.left^.location.reference);
  2127.                 end;
  2128.               if (opt_processors = MC68020) then
  2129.               { alignment is not a problem on the 68020 and higher
  2130. processors }
  2131.                 Begin
  2132.                   { add length of string to word }
  2133.  
  2134. exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_W,$0100,R_D6)));
  2135.                   { put back into mem ...        }
  2136.  
  2137. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_W,R_D6,newreference(p^.location.reference))));
  2138.                 end
  2139.               else
  2140.                 Begin
  2141.                  { alignment can cause problems }
  2142.                   { add length of string to ref }
  2143.  
  2144. exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,1,newreference(p^.location.reference))));
  2145.                   if abs(p^.location.reference.offset) >= 1 then
  2146.                     Begin
  2147.                       { temporarily decrease offset }
  2148.                       Inc(p^.location.reference.offset);
  2149.  
  2150. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_B,R_D6,newreference(p^.location.reference))));
  2151.                       Dec(p^.location.reference.offset);
  2152.                       { restore offset }
  2153.                     end
  2154.                   else
  2155.                    Begin
  2156.                      Comment(V_Debug,'SecondChar2String() internal error.');
  2157.                      internalerror(34);
  2158.                   end;
  2159.                 end;
  2160.            end;
  2161.       end;*)
  2162.  
  2163.     procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
  2164.  
  2165.       begin
  2166.          stringdispose(p^.location.reference.symbol);
  2167.          gettempofsizereference(256,p^.location.reference);
  2168.       { call loadstring with correct left and right }
  2169.          p^.right:=p^.left;
  2170.          p^.left:=p;
  2171.          loadstring(p);
  2172.          p^.left:=nil; { reset left tree, which is empty }
  2173.       end;
  2174.  
  2175.     procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
  2176.  
  2177.       var
  2178.          r : preference;
  2179.         reg:tregister;
  2180.       begin
  2181.         emitloadord2reg(p^.left^.location, porddef(p^.left^.resulttype),
  2182. R_D6, true);
  2183.         ungetiftemp(p^.left^.location.reference);
  2184.         if porddef(p^.left^.resulttype)^.typ=u32bit then
  2185.            push_int(0);
  2186.  
  2187.         emit_reg_reg(A_MOVE, S_L, R_D6, R_SPPUSH);
  2188.         new(r);
  2189.         reset_reference(r^);
  2190.         r^.base := R_SP;
  2191.         { no emulation }
  2192. {           for u32bit a solution would be to push $0 and to load a
  2193. +          comp
  2194. +           if porddef(p^.left^.resulttype)^.typ=u32bit then
  2195. +             exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_Q,r)))
  2196. +           else}
  2197.           p^.location.loc := LOC_FPU;
  2198.           { get floating point register. }
  2199.           if (cs_fp_emulation in aktswitches) then
  2200.           begin
  2201.             p^.location.fpureg := getregister32;
  2202.             exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L, r,
  2203. R_D0)));
  2204.             emitcall('LONG2SINGLE',true);
  2205.             emit_reg_reg(A_MOVE,S_L,R_D0,p^.location.fpureg);
  2206.           end
  2207.           else
  2208.           begin
  2209.             p^.location.fpureg := getfloatreg;
  2210.             exprasmlist^.concat(new(pai68k, op_ref_reg(A_FMOVE, S_L, r,
  2211. p^.location.fpureg)))
  2212.           end;
  2213.         if porddef(p^.left^.resulttype)^.typ=u32bit then
  2214.            exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,8,R_SP)))
  2215.         else
  2216.         { restore the stack to the previous address }
  2217.            exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L, 4,
  2218. R_SP)));
  2219.       end;
  2220.  
  2221.     procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
  2222.  
  2223.       var
  2224.          {hs : string;}
  2225.          rreg : tregister;
  2226.          ref : treference;
  2227.  
  2228.       begin
  2229.          rreg:=getregister32;
  2230.          { Are we in a LOC_FPU, if not then use scratch registers }
  2231.          { instead of allocating reserved registers.              }
  2232.          if (p^.left^.location.loc<>LOC_FPU) then
  2233.          begin
  2234.            if (cs_fp_emulation in aktswitches) then
  2235.            begin
  2236.  
  2237. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),R_D0)));
  2238.  
  2239. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
  2240.              emitcall('LONGMUL',true);
  2241.              emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
  2242.            end
  2243.            else
  2244.            begin
  2245.  
  2246. exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(p^.left^.location.reference),R_FP0)));
  2247.  
  2248. exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,R_FP0)));
  2249.  
  2250. exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,R_FP0,rreg)));
  2251.            end;
  2252.          end
  2253.          else
  2254.          begin
  2255.            if (cs_fp_emulation in aktswitches) then
  2256.            begin
  2257.  
  2258. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));
  2259.  
  2260. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
  2261.              emitcall('LONGMUL',true);
  2262.              emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
  2263.            end
  2264.            else
  2265.            begin
  2266.  
  2267. exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,p^.left^.location.fpureg)));
  2268.  
  2269. exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,p^.left^.location.fpureg,rreg)));
  2270.            end;
  2271.          end;
  2272.          p^.location.loc:=LOC_REGISTER;
  2273.          p^.location.register:=rreg;
  2274.       end;
  2275.  
  2276.     procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
  2277.  
  2278.       begin
  2279.          case p^.left^.location.loc of
  2280.             LOC_FPU :  begin
  2281.                          { reload }
  2282.                          p^.location.loc := LOC_FPU;
  2283.                          p^.location.fpureg := p^.left^.location.fpureg;
  2284.                        end;
  2285.             LOC_MEM,
  2286.             LOC_REFERENCE : floatload(pfloatdef(p^.left^.resulttype)^.typ,
  2287.                               p^.left^.location.reference,p^.location);
  2288.          end;
  2289. { ALREADY HANDLED BY FLOATLOAD      }
  2290. {         p^.location.loc:=LOC_FPU; }
  2291.       end;
  2292.  
  2293.     procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
  2294.  
  2295.     var
  2296.         startreg : tregister;
  2297.         hl : plabel;
  2298.         r : treference;
  2299.         reg1: tregister;
  2300.         hl1,hl2,hl3,hl4,hl5,hl6,hl7,hl8,hl9: plabel;
  2301.       begin
  2302.          if (p^.left^.location.loc=LOC_REGISTER) or
  2303.             (p^.left^.location.loc=LOC_CREGISTER) then
  2304.            begin
  2305.               startreg:=p^.left^.location.register;
  2306.               ungetregister(startreg);
  2307.               { move d0,d0 is removed by emit_reg_reg }
  2308.               emit_reg_reg(A_MOVE,S_L,startreg,R_D0);
  2309.            end
  2310.          else
  2311.            begin
  2312.  
  2313. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
  2314.                 p^.left^.location.reference),R_D0)));
  2315.               del_reference(p^.left^.location.reference);
  2316.               startreg:=R_NO;
  2317.            end;
  2318.  
  2319.          reg1 := getregister32;
  2320.  
  2321.          { Motorola 68000 equivalent of CDQ     }
  2322.          { we choose d1:d0 pair for quad word   }
  2323.          exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D0)));
  2324.          getlabel(hl1);
  2325.          emitl(A_BPL,hl1);
  2326.          { we copy all bits (-ve number) }
  2327.  
  2328. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,$ffffffff,R_D1)));
  2329.          getlabel(hl2);
  2330.          emitl(A_BRA,hl2);
  2331.          emitl(A_LABEL,hl1);
  2332.          exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_D0)));
  2333.          emitl(A_LABEL,hl2);
  2334.          { end CDQ }
  2335.  
  2336.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_EOR,S_L,R_D1,R_D0)));
  2337.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,reg1)));
  2338.          getlabel(hl3);
  2339.          emitl(A_BEQ,hl3);
  2340.  
  2341.          { Motorola 68000 equivalent of RCL    }
  2342.          getlabel(hl4);
  2343.          emitl(A_BCC,hl4);
  2344.          exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
  2345.          exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_L,1,reg1)));
  2346.          getlabel(hl5);
  2347.          emitl(A_BRA,hl5);
  2348.          emitl(A_LABEL,hl4);
  2349.          exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
  2350.          emitl(A_LABEL,hl5);
  2351.          { end RCL }
  2352.  
  2353.          { Motorola 68000 equivalent of BSR }
  2354.          { save register }
  2355.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_D6)));
  2356.          exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,31,R_D0)));
  2357.          getlabel(hl6);
  2358.          emitl(A_LABEL,hl6);
  2359.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,R_D0,R_D1)));
  2360.          getlabel(hl7);
  2361.          emitl(A_BNE,hl7);
  2362.          exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D0)));
  2363.          emitl(A_BPL,hl6);
  2364.          { restore register }
  2365.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D6,R_D0)));
  2366.          emitl(A_LABEL,hl7);
  2367.          { end BSR }
  2368.  
  2369.          exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,32,R_D6)));
  2370.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_B,R_D1,R_D6)));
  2371.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D6,R_D0)));
  2372.          exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_W,1007,R_D1)));
  2373.          exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,5,R_D1)));
  2374.  
  2375.          { Motorola 68000 equivalent of SHLD }
  2376.          exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,11,R_D6)));
  2377.          { save register }
  2378.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D1,R_A0)));
  2379.          getlabel(hl8);
  2380.          emitl(A_LABEL,hl8);
  2381.          exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D1)));
  2382.          exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
  2383.          exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
  2384.          emitl(A_BNE,hl8);
  2385.          { restore register }
  2386.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D1)));
  2387.          { end Motorola equivalent of SHLD }
  2388.  
  2389.          { Motorola 68000 equivalent of SHLD }
  2390.          exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,20,R_D6)));
  2391.          { save register }
  2392.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_A0)));
  2393.          getlabel(hl9);
  2394.          emitl(A_LABEL,hl9);
  2395.          exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D0)));
  2396.          exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
  2397.          exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
  2398.          emitl(A_BNE,hl9);
  2399.          { restore register }
  2400.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D0)));
  2401.          { end Motorola equivalent of SHLD }
  2402.  
  2403.          exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,20,R_D6)));
  2404.          exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_L,R_D6,R_D0)));
  2405.          emitl(A_LABEL, hl3);
  2406.  
  2407.          { create temp values and put on stack }
  2408.  
  2409. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg1,R_SPPUSH)));
  2410.  
  2411. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_SPPUSH)));
  2412.  
  2413.          reset_reference(r);
  2414.          r.base:=R_SP;
  2415.  
  2416.          if (cs_fp_emulation in aktswitches) then
  2417.          begin
  2418.            p^.location.loc:=LOC_FPU;
  2419.            p^.location.fpureg := getregister32;
  2420.  
  2421. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r),
  2422.              p^.left^.location.fpureg)))
  2423.          end
  2424.          else
  2425.          begin
  2426.            p^.location.loc:=LOC_FPU;
  2427.            p^.location.fpureg := getfloatreg;
  2428.  
  2429. exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(r),
  2430.                p^.left^.location.fpureg)))
  2431.          end;
  2432.          { clear temporary space }
  2433.          exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,8,R_SP)));
  2434.          ungetregister32(reg1);
  2435. { Alreadu handled above...          }
  2436. {         p^.location.loc:=LOC_FPU; }
  2437.       end;
  2438.  
  2439.     procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
  2440.  
  2441.       var
  2442.          {hs : string;}
  2443.          hregister : tregister;
  2444.  
  2445.       begin
  2446.          if (p^.left^.location.loc=LOC_REGISTER) then
  2447.            hregister:=p^.left^.location.register
  2448.          else if (p^.left^.location.loc=LOC_CREGISTER) then
  2449.            hregister:=getregister32
  2450.          else
  2451.            begin
  2452.               del_reference(p^.left^.location.reference);
  2453.               hregister:=getregister32;
  2454.               case porddef(p^.left^.resulttype)^.typ of
  2455.                 s8bit : begin
  2456.                            exprasmlist^.concat(new(pai68k,
  2457. op_ref_reg(A_MOVE,S_B,
  2458.  
  2459. newreference(p^.left^.location.reference),hregister)));
  2460.                            if opt_processors = MC68020 then
  2461.                               exprasmlist^.concat(new(pai68k,
  2462. op_reg(A_EXTB,S_L,hregister)))
  2463.                            else
  2464.                             begin
  2465.                               exprasmlist^.concat(new(pai68k,
  2466. op_reg(A_EXT,S_W,hregister)));
  2467.                               exprasmlist^.concat(new(pai68k,
  2468. op_reg(A_EXT,S_L,hregister)));
  2469.                             end;
  2470.                         end;
  2471.                 u8bit : begin
  2472.  
  2473. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.left^.location.reference),
  2474.                             hregister)));
  2475.  
  2476. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
  2477.                         end;
  2478.                 s16bit :begin
  2479.  
  2480. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
  2481.                            hregister)));
  2482.  
  2483. exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,hregister)));
  2484.                         end;
  2485.                 u16bit : begin
  2486.  
  2487. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
  2488.                                hregister)));
  2489.  
  2490. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
  2491.                          end;
  2492.                 s32bit,u32bit :
  2493. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
  2494.                   hregister)));
  2495.                 {!!!! u32bit }
  2496.               end;
  2497.            end;
  2498.          exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ,S_L,16,R_D1)));
  2499.  
  2500. exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D1,hregister)));
  2501.  
  2502.          p^.location.loc:=LOC_REGISTER;
  2503.          p^.location.register:=hregister;
  2504.       end;
  2505.  
  2506.     procedure second_smaller(p,hp : ptree;convtyp : tconverttype);
  2507.  
  2508.       var
  2509.          hregister,destregister : tregister;
  2510.          {opsize : topsize;}
  2511.          ref : boolean;
  2512.          hpp : preference;
  2513.  
  2514.       begin
  2515.          ref:=false;
  2516.          { problems with enums !! }
  2517.          { with $R+ explicit type conversations in TP aren't range checked!
  2518. }
  2519.          if (p^.resulttype^.deftype=orddef) and
  2520.            (hp^.resulttype^.deftype=orddef) and
  2521.            ((porddef(p^.resulttype)^.von>porddef(hp^.resulttype)^.von) or
  2522.            (porddef(p^.resulttype)^.bis<porddef(hp^.resulttype)^.bis)) then
  2523.            begin
  2524.               if (cs_rangechecking in aktswitches) and
  2525.                  (not(p^.explizit) or not(cs_tp_compatible in aktswitches))
  2526. then
  2527.                    porddef(p^.resulttype)^.genrangecheck;
  2528.               if porddef(hp^.resulttype)^.typ=s32bit then
  2529.                 begin
  2530.                    if (p^.location.loc=LOC_REGISTER) or
  2531.                       (p^.location.loc=LOC_CREGISTER) then
  2532.                      hregister:=p^.location.register
  2533.                    else
  2534.                      begin
  2535.                         hregister:=getregister32;
  2536.  
  2537. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),hregister)));
  2538.                      end;
  2539.                 end
  2540.               { rangechecking for u32bit ?? !!!!!!}
  2541.               else if porddef(hp^.resulttype)^.typ=u16bit then
  2542.                 begin
  2543.                    hregister:=getregister32;
  2544.                    if (p^.location.loc=LOC_REGISTER) or
  2545.                       (p^.location.loc=LOC_CREGISTER) then
  2546.                    begin
  2547.  
  2548. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)));
  2549.                    end
  2550.                    else
  2551.  
  2552. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
  2553.                    { clear unused bits  i.e unsigned extend}
  2554.                    exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
  2555. $FFFF, hregister)));
  2556.                 end
  2557.               else if porddef(hp^.resulttype)^.typ=s16bit then
  2558.                 begin
  2559.                    hregister:=getregister32;
  2560.                    if (p^.location.loc=LOC_REGISTER) or
  2561.                       (p^.location.loc=LOC_CREGISTER) then
  2562.  
  2563. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)))
  2564.                    else
  2565.  
  2566. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
  2567.                    { sign extend }
  2568.                    exprasmlist^.concat(new(pai68k,op_reg(A_EXT, S_L,
  2569. hregister)));
  2570.                 end
  2571.               else internalerror(6);
  2572.  
  2573.               if (cs_rangechecking in aktswitches) and
  2574.                  (not(p^.explizit) or not(cs_tp_compatible in aktswitches))
  2575. then
  2576.               Begin
  2577.                 new(hpp);
  2578.                 reset_reference(hpp^);
  2579.  
  2580. hpp^.symbol:=stringdup('R_'+tostr(porddef(p^.resulttype)^.rangenr));
  2581.  
  2582.                 emit_bounds_check(hpp^, hregister);
  2583.               end;
  2584.               p^.location.loc:=LOC_REGISTER;
  2585.               p^.location.register:=hregister;
  2586.               exit;
  2587.            end
  2588.          { -------------- endian problems once again --------------------}
  2589.          { If RIGHT   enumdef (32-bit) and we do a typecase to a smaller }
  2590.          { type we must absolutely load it into a register first.        }
  2591.          { --------------------------------------------------------------}
  2592.          { ------------ supposing enumdef is always 32-bit --------------}
  2593.          { --------------------------------------------------------------}
  2594.          else
  2595.          if (hp^.resulttype^.deftype = enumdef) and (p^.resulttype^.deftype
  2596. = orddef) then
  2597.            begin
  2598.               if (hp^.location.loc=LOC_REGISTER) or
  2599. (hp^.location.loc=LOC_CREGISTER) then
  2600.                  hregister:=hp^.location.register
  2601.               else
  2602.                  begin
  2603.                      hregister:=getregister32;
  2604.  
  2605. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(hp^.location.reference),hregister)));
  2606.                  end;
  2607.               p^.location.loc:=LOC_REGISTER;
  2608.               p^.location.register:=hregister;
  2609.               exit;
  2610.            end;
  2611.          if (p^.left^.location.loc=LOC_REGISTER) or
  2612.            (p^.left^.location.loc=LOC_CREGISTER) then
  2613.            begin
  2614.               { handled by secondpas by called routine ??? }
  2615.               p^.location.register:=p^.left^.location.register;
  2616.            end;
  2617.       end;
  2618.  
  2619.     procedure second_proc_to_procvar(p,hp : ptree;convtyp :
  2620. tconverttype);far;
  2621.  
  2622.     begin
  2623.         secondpass(hp);
  2624.         p^.location.loc:=LOC_REGISTER;
  2625.         del_reference(hp^.location.reference);
  2626.         p^.location.register:=getregister32;
  2627.         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  2628.          newreference(hp^.location.reference),R_A0)));
  2629.  
  2630.         emit_reg_reg(A_MOVE, S_L, R_A0, P^.location.register);
  2631.     end;
  2632.  
  2633.    procedure second_bool_to_byte(p,hp : ptree;convtyp : tconverttype);
  2634.  
  2635.       var
  2636.          oldtruelabel,oldfalselabel,hlabel : plabel;
  2637.  
  2638.      begin
  2639.          oldtruelabel:=truelabel;
  2640.          oldfalselabel:=falselabel;
  2641.          getlabel(truelabel);
  2642.          getlabel(falselabel);
  2643.         secondpass(hp);
  2644.         p^.location.loc:=LOC_REGISTER;
  2645.         del_reference(hp^.location.reference);
  2646.         p^.location.register:=getregister32;
  2647.         case hp^.location.loc of
  2648.           LOC_MEM,LOC_REFERENCE :
  2649.             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
  2650.               newreference(hp^.location.reference),p^.location.register)));
  2651.           LOC_REGISTER,LOC_CREGISTER :
  2652.             exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,
  2653.               hp^.location.register,p^.location.register)));
  2654.            LOC_FLAGS:
  2655.             begin
  2656.  
  2657. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_NO,
  2658.                  p^.location.register)))
  2659.             end;
  2660.            LOC_JUMP:
  2661.              begin
  2662.                 getlabel(hlabel);
  2663.                 emitl(A_LABEL,truelabel);
  2664.                 exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,
  2665.                   1,p^.location.register)));
  2666.                 emitl(A_JMP,hlabel);
  2667.                 emitl(A_LABEL,falselabel);
  2668.  
  2669. exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,p^.location.register)));
  2670.                 emitl(A_LABEL,hlabel);
  2671.              end;
  2672.         else
  2673.           internalerror(10060);
  2674.         end;
  2675.          truelabel:=oldtruelabel;
  2676.          falselabel:=oldfalselabel;
  2677.      end;
  2678.  
  2679.     procedure secondtypeconv(var p : ptree);
  2680.  
  2681.       const
  2682.          secondconvert : array[tc_u8bit_2_s32bit..tc_cchar_charpointer] of
  2683.            tsecondconvproc = (second_bigger,second_only_rangecheck,
  2684.                               second_bigger,second_bigger,second_bigger,
  2685.                               second_smaller,second_smaller,
  2686.                               second_smaller,second_string_string,
  2687.  
  2688. second_cstring_charpointer,second_string_chararray,
  2689.  
  2690. second_array_to_pointer,second_pointer_to_array,
  2691.                               second_char_to_string,second_bigger,
  2692.                               second_bigger,second_bigger,
  2693.                               second_smaller,second_smaller,
  2694.                               second_smaller,second_smaller,
  2695.                               second_bigger,second_smaller,
  2696.                               second_only_rangecheck,second_bigger,
  2697.                               second_bigger,second_bigger,
  2698.                               second_bigger,second_only_rangecheck,
  2699.                               second_int_real,second_real_fix,
  2700.  
  2701. second_fix_real,second_int_fix,second_float_float,
  2702.                        second_chararray_to_string,second_bool_to_byte,
  2703.                        second_proc_to_procvar,
  2704.                        { is constant char to pchar, is done by firstpass }
  2705.                        second_nothing);
  2706.  
  2707.       begin
  2708.          { this isn't good coding, I think tc_bool_2_u8bit, shouldn't be }
  2709.          { type conversion (FK)                                        }
  2710.  
  2711.          { this is necessary, because second_bool_byte, have to change   }
  2712.          { true- and false label before calling secondpass               }
  2713.          if p^.convtyp<>tc_bool_2_u8bit then
  2714.          begin
  2715.            secondpass(p^.left);
  2716.            set_location(p^.location,p^.left^.location);
  2717.          end;
  2718.          if p^.convtyp<>tc_equal then
  2719.            {the second argument only is for maybe_range_checking !}
  2720.            secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
  2721.       end;
  2722.  
  2723.     { save the size of pushed parameter }
  2724.     var
  2725.        pushedparasize : longint;
  2726.  
  2727.     procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
  2728.                 push_from_left_to_right : boolean);
  2729.  
  2730.       var
  2731.          size : longint;
  2732.          stackref : treference;
  2733.          otlabel,hlabel,oflabel : plabel;
  2734.  
  2735.          { temporary variables: }
  2736.          tempdeftype : tdeftype;
  2737.          tempreference : treference;
  2738.          r : preference;
  2739.          s : topsize;
  2740.          op : tasmop;
  2741.          reg: tregister;
  2742.  
  2743.       begin
  2744.          { push from left to right if specified }
  2745.          if push_from_left_to_right and assigned(p^.right) then
  2746.            secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
  2747.          otlabel:=truelabel;
  2748.          oflabel:=falselabel;
  2749.          getlabel(truelabel);
  2750.          getlabel(falselabel);
  2751.          secondpass(p^.left);
  2752.          { in codegen.handleread.. defcoll^.data is set to nil }
  2753.          if assigned(defcoll^.data) and
  2754.            (defcoll^.data^.deftype=formaldef) then
  2755.            begin
  2756.               { allow @var }
  2757.               if p^.left^.treetype=addrn then
  2758.                 begin
  2759.                    { allways a register }
  2760.  
  2761. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_SPPUSH)));
  2762.                    ungetregister32(p^.left^.location.register);
  2763.                 end
  2764.               else
  2765.                 begin
  2766.                    if (p^.left^.location.loc<>LOC_REFERENCE) and
  2767.                       (p^.left^.location.loc<>LOC_MEM) then
  2768.                      Message(sym_e_type_mismatch)
  2769.                    else
  2770.                      begin
  2771.                         emitpushreferenceaddr(p^.left^.location.reference);
  2772.                         del_reference(p^.left^.location.reference);
  2773.                      end;
  2774.                 end;
  2775.               inc(pushedparasize,4);
  2776.            end
  2777.          { handle call by reference parameter }
  2778.          else if (defcoll^.paratyp=vs_var) then
  2779.            begin
  2780.               if (p^.left^.location.loc<>LOC_REFERENCE) then
  2781.                 Message(cg_e_var_must_be_reference);
  2782.               { open array ? }
  2783.               { defcoll^.data can be nil for read/write }
  2784.               if assigned(defcoll^.data) and
  2785.                 is_open_array(defcoll^.data) then
  2786.                 begin
  2787.                    { push high }
  2788.                    if is_open_array(p^.left^.resulttype) then
  2789.                      begin
  2790.                         new(r);
  2791.                         reset_reference(r^);
  2792.                         r^.base:=highframepointer;
  2793.                         r^.offset:=highoffset+4;
  2794.  
  2795. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)));
  2796.                      end
  2797.                    else
  2798.                      push_int(parraydef(p^.left^.resulttype)^.highrange-
  2799.                               parraydef(p^.left^.resulttype)^.lowrange);
  2800.                    inc(pushedparasize,4);
  2801.                 end;
  2802.               emitpushreferenceaddr(p^.left^.location.reference);
  2803.               del_reference(p^.left^.location.reference);
  2804.               inc(pushedparasize,4);
  2805.            end
  2806.          else
  2807.            begin
  2808.               tempdeftype:=p^.resulttype^.deftype;
  2809.               if tempdeftype=filedef then
  2810.                 Message(cg_e_file_must_call_by_reference);
  2811.               if (defcoll^.paratyp=vs_const) and
  2812.                  dont_copy_const_param(p^.resulttype) then
  2813.                 begin
  2814.                    emitpushreferenceaddr(p^.left^.location.reference);
  2815.                    del_reference(p^.left^.location.reference);
  2816.                    inc(pushedparasize,4);
  2817.                 end
  2818.               else
  2819.                 case p^.left^.location.loc of
  2820.                    LOC_REGISTER,
  2821.                    LOC_CREGISTER : begin
  2822.                                    { HERE IS A BIG PROBLEM }
  2823.                                    { ----------------- HACK
  2824. ----------------------- }
  2825.                                    { --> We *MUST* know the data size to
  2826. push     }
  2827.                                    { for the moment, we can say that the
  2828. savesize }
  2829.                                    { indicates the parameter size to push,
  2830. but    }
  2831.                                    { that is CERTAINLY NOT TRUE!
  2832. }
  2833.                                    { CAN WE USE LIKE LOC_MEM OR
  2834. LOC_REFERENCE??   }
  2835.                                      case
  2836. integer(p^.left^.resulttype^.savesize) of
  2837.                                      1 : Begin
  2838.                                      { A byte sized value normally
  2839. increments       }
  2840.                                      { the SP by 2, BUT because how memory
  2841. has      }
  2842.                                      { been setup OR because of GAS, a byte
  2843. sized   }
  2844.                                      { push CRASHES the Amiga, therefore, we
  2845. do it  }
  2846.                                      { by hand instead.
  2847. }
  2848.                                      {  PUSH A WORD SHIFTED LEFT 8
  2849. }
  2850.                                            reg := getregister32;
  2851.                                            emit_reg_reg(A_MOVE, S_B,
  2852. p^.left^.location.register, reg);
  2853.  
  2854. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
  2855.                                              8, reg)));
  2856.  
  2857. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
  2858.                                             reg,R_SPPUSH)));
  2859.                                            { offset will be TWO greater
  2860. }
  2861.                                            inc(pushedparasize,2);
  2862.                                            ungetregister32(reg);
  2863.  
  2864. ungetregister32(p^.left^.location.register);
  2865.                                          end;
  2866.                                      2 :
  2867.                                               Begin
  2868.  
  2869. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
  2870.  
  2871. p^.left^.location.register,R_SPPUSH)));
  2872.                                                  inc(pushedparasize,2);
  2873.  
  2874. ungetregister32(p^.left^.location.register);
  2875.                                               end;
  2876.                                       4 : Begin
  2877.  
  2878. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  2879.  
  2880. p^.left^.location.register,R_SPPUSH)));
  2881.                                              inc(pushedparasize,4);
  2882.  
  2883. ungetregister32(p^.left^.location.register);
  2884.                                           end;
  2885.                                       else
  2886.                                        Begin
  2887.  
  2888. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  2889.  
  2890. p^.left^.location.register,R_SPPUSH)));
  2891.                                          inc(pushedparasize,4);
  2892.  
  2893. ungetregister32(p^.left^.location.register);
  2894.                                        end;
  2895.                                      end; { end case }
  2896.                                    end;
  2897.                    LOC_FPU : begin
  2898.  
  2899. size:=pfloatdef(p^.left^.resulttype)^.size;
  2900.                                         inc(pushedparasize,size);
  2901.  
  2902. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)));
  2903.                                         new(r);
  2904.                                         reset_reference(r^);
  2905.                                         r^.base:=R_SP;
  2906.  
  2907. s:=getfloatsize(pfloatdef(p^.left^.resulttype)^.typ);
  2908.                                         if (cs_fp_emulation in aktswitches)
  2909. or (s=S_S) then
  2910.                                         begin
  2911.                                           { when in emulation mode... }
  2912.                                           { only single supported!!!  }
  2913.  
  2914. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
  2915.                                              p^.left^.location.fpureg,r)));
  2916.                                         end
  2917.                                         else
  2918.                                           { convert back from extended to
  2919. normal type }
  2920.  
  2921. exprasmlist^.concat(new(pai68k,op_reg_ref(A_FMOVE,s,
  2922.                                              p^.left^.location.fpureg,r)));
  2923.                                      end;
  2924.                    LOC_REFERENCE,LOC_MEM :
  2925.                                begin
  2926.  
  2927. tempreference:=p^.left^.location.reference;
  2928.  
  2929. del_reference(p^.left^.location.reference);
  2930.                                   case p^.resulttype^.deftype of
  2931.                                      orddef : begin
  2932.                                                    case
  2933. porddef(p^.resulttype)^.typ of
  2934.                                                       s32bit,u32bit :
  2935.                                                         begin
  2936.  
  2937. emit_push_mem(tempreference);
  2938.  
  2939. inc(pushedparasize,4);
  2940.                                                         end;
  2941.  
  2942. s8bit,u8bit,uchar,bool8bit:
  2943.                                                       Begin
  2944.                                                           {
  2945. ----------------- HACK ----------------------- }
  2946.                                                           { We push a
  2947. byte,the SP is incremented by 2      }
  2948.                                                           { as specified in
  2949. the Motorola Prog's Ref Manual }
  2950.                                                           { Therefore offet
  2951. increments BY 2!!!             }
  2952.                                                           { SWAP OPERANDS:
  2953. }
  2954.                                                           if
  2955. tempreference.isintvalue then
  2956.                                                           Begin
  2957.  
  2958. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,
  2959.  
  2960. tempreference.offset shl 8,R_SPPUSH)));
  2961.                                                           end
  2962.                                                           else
  2963.                                                           Begin
  2964.                                                            {
  2965. ----------------- HACK ----------------------- }
  2966.                                                            { A byte sized
  2967. value normally increments       }
  2968.                                                            { the SP by 2,
  2969. BUT because how memory has      }
  2970.                                                            { been setup OR
  2971. because of GAS, a byte sized   }
  2972.                                                            { push CRASHES
  2973. the Amiga, therefore, we do it  }
  2974.                                                            { by hand
  2975. instead.                             }
  2976.                                                            {  PUSH A WORD
  2977. SHIFTED LEFT 8                  }
  2978.  
  2979. reg:=getregister32;
  2980.  
  2981. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
  2982.  
  2983. newreference(tempreference),reg)));
  2984.  
  2985. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
  2986.                                                              8, reg)));
  2987.  
  2988. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
  2989.  
  2990. reg,R_SPPUSH)));
  2991.  
  2992. ungetregister32(reg);
  2993. {
  2994. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  2995.  
  2996. newreference(tempreference),R_SPPUSH))); }
  2997.                                                           end;
  2998.  
  2999. inc(pushedparasize,2);
  3000.  
  3001.                                                       end;
  3002.                                                       s16bit,u16bit : begin
  3003.  
  3004. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  3005.  
  3006. newreference(tempreference),R_SPPUSH)));
  3007.  
  3008. inc(pushedparasize,2);
  3009.                                                       end;
  3010.                                                     end;
  3011.                                               end;
  3012.                                      floatdef : begin
  3013.                                                    case
  3014. pfloatdef(p^.resulttype)^.typ of
  3015.                                                       f32bit,
  3016.                                                       s32real :
  3017.                                                         begin
  3018.  
  3019. emit_push_mem(tempreference);
  3020.  
  3021. inc(pushedparasize,4);
  3022.                                                         end;
  3023.                                                       s64real:
  3024.                                                       {s64bit }
  3025.                                                                 begin
  3026.  
  3027. inc(tempreference.offset,4);
  3028.  
  3029. emit_push_mem(tempreference);
  3030.  
  3031. dec(tempreference.offset,4);
  3032.  
  3033. emit_push_mem(tempreference);
  3034.  
  3035. inc(pushedparasize,8);
  3036.                                                                 end;
  3037. {$ifdef use48}
  3038.                                                       s48real : begin
  3039.                                                                 end;
  3040. {$endif}
  3041.                                                       s80real : begin
  3042.  
  3043. Message(cg_f_extended_cg68k_not_supported);
  3044. {
  3045. inc(tempreference.offset,6);
  3046.  
  3047. emit_push_mem(tempreference);
  3048.  
  3049. dec(tempreference.offset,4);
  3050.  
  3051. emit_push_mem(tempreference);
  3052.  
  3053. dec(tempreference.offset,2);
  3054.  
  3055. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  3056.  
  3057. newreference(tempreference),R_SPPUSH)));
  3058.  
  3059. inc(pushedparasize,extended_size);}
  3060.                                                                 end;
  3061.                                                    end;
  3062.                                                 end;
  3063.                                      pointerdef,procvardef,
  3064.                                          enumdef,classrefdef:  begin
  3065.  
  3066. emit_push_mem(tempreference);
  3067.                                                       inc(pushedparasize,4);
  3068.                                                    end;
  3069.  
  3070. arraydef,recorddef,stringdef,setdef,objectdef :
  3071.                                                 begin
  3072.                                                    if
  3073. ((p^.resulttype^.deftype=setdef) and
  3074.  
  3075. (psetdef(p^.resulttype)^.settype=smallset)) then
  3076.                                                      begin
  3077.  
  3078. emit_push_mem(tempreference);
  3079.  
  3080. inc(pushedparasize,4);
  3081.                                                      end
  3082.                                                    else
  3083.                                                      begin
  3084.  
  3085. size:=p^.resulttype^.size;
  3086.  
  3087.                                                         { Alignment }
  3088.                                                         {
  3089.                                                         if (size>=4) and
  3090. ((size and 3)<>0) then
  3091.                                                           inc(size,4-(size
  3092. and 3))
  3093.                                                         else if (size>=2)
  3094. and ((size and 1)<>0) then
  3095.                                                           inc(size,2-(size
  3096. and 1))
  3097.                                                         else
  3098.                                                         if size=1 then
  3099. size:=2;
  3100.                                                         }
  3101.                                                         { create stack space
  3102. }
  3103.                                                         if (size > 0) and
  3104. (size < 9) then
  3105.  
  3106. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)))
  3107.                                                         else
  3108.  
  3109. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBA,
  3110.  
  3111. S_L,size,R_SP)));
  3112.  
  3113. inc(pushedparasize,size);
  3114.                                                         { create stack
  3115. reference }
  3116.                                                         stackref.symbol :=
  3117. nil;
  3118.  
  3119. clear_reference(stackref);
  3120.                                                         stackref.base:=R_SP;
  3121.                                                         { produce copy }
  3122.                                                         if
  3123. p^.resulttype^.deftype=stringdef then
  3124.                                                           begin
  3125.  
  3126. copystring(stackref,p^.left^.location.reference,
  3127.  
  3128. pstringdef(p^.resulttype)^.len);
  3129.                                                           end
  3130.                                                         else
  3131.                                                           begin
  3132.  
  3133. concatcopy(p^.left^.location.reference,
  3134.  
  3135. stackref,p^.resulttype^.size,true);
  3136.                                                           end;
  3137.                                                      end;
  3138.                                                 end;
  3139.                                      else Message(cg_e_illegal_expression);
  3140.                                   end;
  3141.                                end;
  3142.                  LOC_JUMP     : begin
  3143.                                    getlabel(hlabel);
  3144.                                    inc(pushedparasize,2);
  3145.                                    emitl(A_LABEL,truelabel);
  3146.  
  3147. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,1 shl 8,R_SPPUSH)));
  3148.                                    emitl(A_JMP,hlabel);
  3149.                                    emitl(A_LABEL,falselabel);
  3150.  
  3151. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,0,R_SPPUSH)));
  3152.                                    emitl(A_LABEL,hlabel);
  3153.                                 end;
  3154.                  LOC_FLAGS    : begin
  3155.  
  3156. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
  3157.                                      R_D0)));
  3158.  
  3159. exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
  3160.  
  3161. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_W,$ff, R_D0)));
  3162.                                    inc(pushedparasize,2);
  3163.                                    { ----------------- HACK
  3164. ----------------------- }
  3165.                                    { HERE IS THE BYTE SIZED PUSH HACK ONCE
  3166. AGAIN    }
  3167.                                    { SHIFT LEFT THE BYTE TO MAKE IT WORK!
  3168. }
  3169.  
  3170. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,8, R_D0)));
  3171.  
  3172. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,R_D0,R_SPPUSH)));
  3173.                                 end;
  3174.                 end;
  3175.            end;
  3176.          truelabel:=otlabel;
  3177.          falselabel:=oflabel;
  3178.          { push from right to left }
  3179.          if not push_from_left_to_right and assigned(p^.right) then
  3180.            secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
  3181.       end;
  3182.  
  3183.     procedure secondcalln(var p : ptree);
  3184.  
  3185.       var
  3186.          unusedregisters : tregisterset;
  3187.          pushed : tpushed;
  3188.          funcretref : treference;
  3189.          hregister : tregister;
  3190.          oldpushedparasize : longint;
  3191.          { true if a5 must be loaded again after the subroutine }
  3192.          loada5 : boolean;
  3193.          { true if a virtual method must be called directly }
  3194.          no_virtual_call : boolean;
  3195.          { true if we produce a con- or destrutor in a call }
  3196.          is_con_or_destructor : boolean;
  3197.          { true if a constructor is called again }
  3198.          extended_new : boolean;
  3199.          { adress returned from an I/O-error }
  3200.          iolabel : plabel;
  3201.          { lexlevel count }
  3202.          i : longint;
  3203.          { help reference pointer }
  3204.          r : preference;
  3205.          pp,params : ptree;
  3206.          { temp register allocation }
  3207.          reg: tregister;
  3208.          { help reference pointer }
  3209.          ref: preference;
  3210.  
  3211.       label
  3212.          dont_call;
  3213.  
  3214.       begin
  3215.          extended_new:=false;
  3216.          iolabel:=nil;
  3217.          loada5:=true;
  3218.          no_virtual_call:=false;
  3219.          unusedregisters:=unused;
  3220.          if not assigned(p^.procdefinition) then
  3221.            exit;
  3222.          { only if no proc var }
  3223.          if not(assigned(p^.right)) then
  3224.            is_con_or_destructor:=((p^.procdefinition^.options and
  3225. poconstructor)<>0)
  3226.              or ((p^.procdefinition^.options and podestructor)<>0);
  3227.          { proc variables destroy all registers }
  3228.          if (p^.right=nil) and
  3229.          { virtual methods too }
  3230.            ((p^.procdefinition^.options and povirtualmethod)=0) then
  3231.            begin
  3232.               if ((p^.procdefinition^.options and poiocheck)<>0)
  3233.                 and (cs_iocheck in aktswitches) then
  3234.                 begin
  3235.                        getlabel(iolabel);
  3236.                    emitl(A_LABEL,iolabel);
  3237.                 end
  3238.               else iolabel:=nil;
  3239.  
  3240.               { save all used registers }
  3241.               pushusedregisters(pushed,p^.procdefinition^.usedregisters);
  3242.  
  3243.               { give used registers through }
  3244.               usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
  3245.            end
  3246.          else
  3247.            begin
  3248.               pushusedregisters(pushed,$ffff);
  3249.               usedinproc:=$ffff;
  3250.  
  3251.               { no IO check for methods and procedure variables }
  3252.               iolabel:=nil;
  3253.            end;
  3254.  
  3255.          { generate the code for the parameter and push them }
  3256.          oldpushedparasize:=pushedparasize;
  3257.          pushedparasize:=0;
  3258.          if (p^.resulttype<>pdef(voiddef)) and
  3259.             ret_in_param(p^.resulttype) then
  3260.            begin
  3261.               funcretref.symbol:=nil;
  3262. {$ifdef test_dest_loc}
  3263.               if dest_loc_known and (dest_loc_tree=p) and
  3264.                  (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
  3265.                 begin
  3266.                    funcretref:=dest_loc.reference;
  3267.                    if assigned(dest_loc.reference.symbol) then
  3268.  
  3269. funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
  3270.                    in_dest_loc:=true;
  3271.                 end
  3272.               else
  3273. {$endif test_dest_loc}
  3274.  
  3275. gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
  3276.            end;
  3277.          if assigned(p^.left) then
  3278.            begin
  3279.               pushedparasize:=0;
  3280.               { be found elsewhere }
  3281.               if assigned(p^.right) then
  3282.  
  3283. secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
  3284.                   (p^.procdefinition^.options and poleftright)<>0)
  3285.               else
  3286.                 secondcallparan(p^.left,p^.procdefinition^.para1,
  3287.                   (p^.procdefinition^.options and poleftright)<>0);
  3288.            end;
  3289.          params:=p^.left;
  3290.          p^.left:=nil;
  3291.          if ret_in_param(p^.resulttype) then
  3292.            begin
  3293.               emitpushreferenceaddr(funcretref);
  3294.               inc(pushedparasize,4);
  3295.            end;
  3296.          { overloaded operator have no symtable }
  3297.          if (p^.right=nil) then
  3298.            begin
  3299.               { push self }
  3300.               if assigned(p^.symtable) and
  3301.                 (p^.symtable^.symtabletype=withsymtable) then
  3302.                 begin
  3303.                    { dirty trick to avoid the secondcall below }
  3304.                    p^.methodpointer:=genzeronode(callparan);
  3305.                    p^.methodpointer^.location.loc:=LOC_REGISTER;
  3306.                    p^.methodpointer^.location.register:=R_A5;
  3307.                    { make a reference }
  3308.                    new(r);
  3309.                    reset_reference(r^);
  3310.                    r^.offset:=p^.symtable^.datasize;
  3311.                    r^.base:=procinfo.framepointer;
  3312.  
  3313. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
  3314.                 end;
  3315.  
  3316.               { push self }
  3317.               if assigned(p^.symtable) and
  3318.                 ((p^.symtable^.symtabletype=objectsymtable) or
  3319.                 (p^.symtable^.symtabletype=withsymtable)) then
  3320.                 begin
  3321.                    if assigned(p^.methodpointer) then
  3322.                      begin
  3323.                         case p^.methodpointer^.treetype of
  3324.                            typen : begin
  3325.                                       { direct call to inherited method }
  3326.                                       if (p^.procdefinition^.options and
  3327. poabstractmethod)<>0 then
  3328.                                         begin
  3329.  
  3330. Message(cg_e_cant_call_abstract_method);
  3331.                                            goto dont_call;
  3332.                                         end;
  3333.                                       { generate no virtual call }
  3334.                                       no_virtual_call:=true;
  3335.                              if (p^.symtableprocentry^.properties and
  3336. sp_static)<>0 then
  3337.                                  begin
  3338.                                     { well lets put the VMT address directly
  3339. into a5 }
  3340.                                     { it is kind of dirty but that is the
  3341. simplest    }
  3342.                                     { way to accept virtual static functions
  3343. (PM)     }
  3344.                                     loada5:=true;
  3345.  
  3346. exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,S_L,
  3347.  
  3348. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_A5)));
  3349.  
  3350. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  3351.  
  3352. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  3353.                                  end
  3354.                                else
  3355.  
  3356.                                   { this is a member call, so A5 isn't
  3357. modfied }
  3358.                                   loada5:=false;
  3359.  
  3360.                                if not(is_con_or_destructor and
  3361.  
  3362. pobjectdef(p^.methodpointer^.resulttype)^.isclass and
  3363.                                   assigned(aktprocsym) and
  3364.                                   ((aktprocsym^.definition^.options and
  3365.                                   (poconstructor or podestructor))<>0)) then
  3366.  
  3367. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  3368.                                  { if an inherited con- or destructor should
  3369. be  }
  3370.                                  { called in a con- or destructor then a
  3371. warning }
  3372.                                  { will be made
  3373. }
  3374.                                  { con- and destructors need a pointer to
  3375. the vmt }
  3376.                                  if is_con_or_destructor and
  3377.  
  3378. ((pobjectdef(p^.methodpointer^.resulttype)^.options and oois_class)=0) and
  3379.                                    assigned(aktprocsym) then
  3380.                                    begin
  3381.                                     if not ((aktprocsym^.definition^.options
  3382.                                       and (poconstructor or
  3383. podestructor))<>0) then
  3384.  
  3385. Message(cg_w_member_cd_call_from_method);
  3386.                                    end;
  3387.                                       { con- and destructors need a pointer
  3388. to the vmt }
  3389.                                       if is_con_or_destructor then
  3390.                                         begin
  3391.                                            { classes need the mem ! }
  3392.                                            if
  3393. ((pobjectdef(p^.methodpointer^.resulttype)^.options and
  3394.  
  3395.                                             oois_class)=0) then
  3396.                                              push_int(0)
  3397.                                            else
  3398.                                                begin
  3399.  
  3400. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,
  3401.  
  3402. S_L,newcsymbol(pobjectdef(p^.methodpointer^.
  3403.  
  3404. resulttype)^.vmt_mangledname,0))));
  3405.  
  3406. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.
  3407.                                                   vmt_mangledname,EXT_NEAR);
  3408.                                                end;
  3409.                                         end;
  3410.                                    end;
  3411.                            hnewn : begin
  3412.                                      { extended syntax of new }
  3413.                                      { A5 must be zero }
  3414.  
  3415. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,0,R_A5)));
  3416.                                      emit_reg_reg(A_MOVE,S_L,R_A5,
  3417. R_SPPUSH);
  3418.                                      { insert the vmt }
  3419.  
  3420. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
  3421.  
  3422. newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  3423.  
  3424. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  3425.                                               extended_new:=true;
  3426.                                   end;
  3427.                            hdisposen : begin
  3428.                                           secondpass(p^.methodpointer);
  3429.  
  3430.                                           { destructor with extended syntax
  3431. called from dispose }
  3432.                                           { hdisposen always deliver
  3433. LOC_REFRENZ }
  3434.  
  3435. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  3436.  
  3437. newreference(p^.methodpointer^.location.reference),R_A5)));
  3438.  
  3439. del_reference(p^.methodpointer^.location.reference);
  3440.  
  3441. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  3442.  
  3443. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
  3444.                                             newcsymbol(pobjectdef
  3445.  
  3446. (p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  3447.  
  3448. concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  3449.                                        end;
  3450.                            else
  3451.                              begin
  3452.                                 { call to a instance member }
  3453.                                 if (p^.symtable^.symtabletype<>withsymtable)
  3454. then
  3455.                                   begin
  3456.                                      secondpass(p^.methodpointer);
  3457.  
  3458.                                      case p^.methodpointer^.location.loc of
  3459.                                         LOC_REGISTER :
  3460.                                            begin
  3461.  
  3462. ungetregister32(p^.methodpointer^.location.register);
  3463.  
  3464. emit_reg_reg(A_MOVE,S_L,p^.methodpointer^.location.register,R_A5);
  3465.                                            end;
  3466.                                         else
  3467.                                            begin
  3468.                                                  if
  3469. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  3470.  
  3471. pobjectdef(p^.methodpointer^.resulttype)^.isclass then
  3472.  
  3473. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  3474.  
  3475. newreference(p^.methodpointer^.location.reference),R_A5)))
  3476.                                                  else
  3477.                                                   Begin
  3478.  
  3479. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  3480.  
  3481. newreference(p^.methodpointer^.location.reference),R_A5)));
  3482.                                                   end;
  3483.  
  3484. del_reference(p^.methodpointer^.location.reference);
  3485.                                              end;
  3486.                                      end;
  3487.                                   end;
  3488.                                     { when calling a class method, we have
  3489.                                       to load ESI with the VMT !
  3490.                                       But that's wrong, if we call a class
  3491. method via self
  3492.                                     }
  3493.                                     if ((p^.procdefinition^.options and
  3494. poclassmethod)<>0)
  3495.                                        and
  3496. not(p^.methodpointer^.treetype=selfn) then
  3497.                                       begin
  3498.                                          { class method needs current VMT }
  3499.                                          new(r);
  3500.                                          reset_reference(r^);
  3501.                                          r^.base:=R_A5;
  3502.  
  3503. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
  3504.                                       end;
  3505.  
  3506. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  3507.                                    if is_con_or_destructor then
  3508.                                    begin
  3509.                                          { classes don't get a VMT pointer
  3510. pushed }
  3511.                                          if
  3512. (p^.methodpointer^.resulttype^.deftype=objectdef) and
  3513.  
  3514. not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
  3515.                                            begin
  3516.  
  3517.                                             if ((p^.procdefinition^.options
  3518. and poconstructor)<>0) then
  3519.                                               begin
  3520.                                                { it's no bad idea, to insert
  3521. the VMT }
  3522.  
  3523. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
  3524.                                                newcsymbol(pobjectdef(
  3525.  
  3526. p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
  3527.                                                concat_external(pobjectdef(
  3528.  
  3529. p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
  3530.                                               end
  3531.                                             { destructors haven't to dispose
  3532. the instance, if this is }
  3533.                                             { a direct call
  3534. }
  3535.                                             else
  3536.                                               push_int(0);
  3537.                                            end;
  3538.                                   end;
  3539.                              end;
  3540.                         end;
  3541.                      end
  3542.                    else
  3543.                      begin
  3544.                          if ((p^.procdefinition^.options and
  3545. poclassmethod)<>0) and
  3546.                           not(
  3547.                             assigned(aktprocsym) and
  3548.                             ((aktprocsym^.definition^.options and
  3549. poclassmethod)<>0)
  3550.                           ) then
  3551.                           begin
  3552.                              { class method needs current VMT }
  3553.                              new(r);
  3554.                              reset_reference(r^);
  3555.                              r^.base:=R_A5;
  3556.  
  3557. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
  3558.                           end
  3559.                         else
  3560.                           begin
  3561.                              { member call, A5 isn't modified }
  3562.                              loada5:=false;
  3563.                           end;
  3564.  
  3565. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
  3566.             { but a con- or destructor here would probably almost }
  3567.                         { always be placed wrong }
  3568.                         if is_con_or_destructor then
  3569.                           begin
  3570.                              Message(cg_w_member_cd_call_from_method);
  3571.                              { not insert VMT pointer }
  3572. { VMT-Zeiger nicht eintragen }
  3573.                              push_int(0);
  3574.                           end;
  3575.                      end;
  3576.                 end;
  3577.  
  3578.               { push base pointer ?}
  3579.               if (lexlevel>1) and
  3580. assigned(pprocdef(p^.procdefinition)^.parast) and
  3581.             ((p^.procdefinition^.parast^.symtablelevel)>2) then
  3582.                     begin
  3583.                    { if we call a nested function in a method, we must
  3584. }
  3585.                    { push also SELF!
  3586. }
  3587.                    { THAT'S NOT TRUE, we have to load ESI via frame pointer
  3588. }
  3589.                    { access
  3590. }
  3591.                    {
  3592.                      begin
  3593.                         loadesi:=false;
  3594.  
  3595. exprasmlist^.concat(new(pai68k,op_reg(A_PUSH,S_L,R_ESI)));
  3596.                      end;
  3597.                    }
  3598.                    if lexlevel=(p^.procdefinition^.parast^.symtablelevel)
  3599. then
  3600.                      begin
  3601.                         new(r);
  3602.                         reset_reference(r^);
  3603.                         r^.offset:=procinfo.framepointer_offset;
  3604.                         r^.base:=procinfo.framepointer;
  3605.  
  3606. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)))
  3607.                      end
  3608.                      { this is only true if the difference is one !!
  3609.                        but it cannot be more !! }
  3610.                    else if
  3611. lexlevel=(p^.procdefinition^.parast^.symtablelevel)-1 then
  3612.                      begin
  3613.  
  3614. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,procinfo.framepointer,R_SPPUSH)))
  3615.                      end
  3616.                    else if
  3617. lexlevel>(p^.procdefinition^.parast^.symtablelevel) then
  3618.                      begin
  3619.                         hregister:=getaddressreg;
  3620.                         new(r);
  3621.                         reset_reference(r^);
  3622.                         r^.offset:=procinfo.framepointer_offset;
  3623.                         r^.base:=procinfo.framepointer;
  3624.  
  3625. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
  3626.                         for i:=(p^.procdefinition^.parast^.symtablelevel) to
  3627. lexlevel-1 do
  3628.                           begin
  3629.                              new(r);
  3630.                              reset_reference(r^);
  3631.                              {we should get the correct frame_pointer_offset
  3632. at each level
  3633.                              how can we do this !!! }
  3634.                              r^.offset:=procinfo.framepointer_offset;
  3635.                              r^.base:=hregister;
  3636.  
  3637. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
  3638.                           end;
  3639.  
  3640. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH)));
  3641.                         ungetregister32(hregister);
  3642.                      end
  3643.                    else
  3644.                      internalerror(25000);
  3645.                 end;
  3646.  
  3647.               { exported methods should be never called direct }
  3648.               if (p^.procdefinition^.options and poexports)<>0 then
  3649.                Message(cg_e_dont_call_exported_direct);
  3650.  
  3651.               if ((p^.procdefinition^.options and povirtualmethod)<>0) and
  3652.                  not(no_virtual_call) then
  3653.                 begin
  3654.                    { static functions contain the vmt_address in ESI }
  3655.                    { also class methods                              }
  3656.                    if assigned(aktprocsym) then
  3657.                      begin
  3658.                        if ((aktprocsym^.properties and sp_static)<>0) or
  3659.                         ((aktprocsym^.definition^.options and
  3660. poclassmethod)<>0) or
  3661.                         ((p^.procdefinition^.options and postaticmethod)<>0)
  3662. or
  3663.                         { A5 is already loaded  }
  3664.                         ((p^.procdefinition^.options and
  3665. poclassmethod)<>0)then
  3666.                          begin
  3667.                             new(r);
  3668.                             reset_reference(r^);
  3669.                             r^.base:=R_a5;
  3670.                          end
  3671.                        else
  3672.                          begin
  3673.                             new(r);
  3674.                             reset_reference(r^);
  3675.                             r^.base:=R_a5;
  3676.  
  3677. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
  3678.                             new(r);
  3679.                             reset_reference(r^);
  3680.                             r^.base:=R_a0;
  3681.                          end;
  3682.                      end
  3683.                    else
  3684.                      begin
  3685.                        new(r);
  3686.                        reset_reference(r^);
  3687.                        r^.base:=R_a5;
  3688.  
  3689. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
  3690.                        new(r);
  3691.                        reset_reference(r^);
  3692.                        r^.base:=R_a0;
  3693.                      end;
  3694.                    if p^.procdefinition^.extnumber=-1 then
  3695.                      internalerror($Da);
  3696.                    r^.offset:=p^.procdefinition^.extnumber*4+12;
  3697.                    if (cs_rangechecking in aktswitches) then
  3698.                    begin
  3699.                      { If the base is already A0, the no instruction will }
  3700.                      { be emitted!                                        }
  3701.                      emit_reg_reg(A_MOVE,S_L,r^.base,R_A0);
  3702.                      emitcall('CHECK_OBJECT',true);
  3703.                    end;
  3704.                    { This was wrong we must then load the address into the }
  3705.                    { register a0 and/or a5                                 }
  3706.                    { Because doing an indirect call with offset is NOT     }
  3707.                    { allowed on the m68k!                                  }
  3708.  
  3709. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r^),R_A0)));
  3710.                    { clear the reference }
  3711.                    reset_reference(r^);
  3712.                    r^.base := R_A0;
  3713.                    exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,r)));
  3714.                 end
  3715.               else if (p^.procdefinition^.options and popalmossyscall)<>0
  3716. then
  3717.                 begin
  3718.  
  3719. exprasmlist^.concat(new(pai68k,op_const(A_TRAP,S_NO,15)));
  3720.  
  3721. exprasmlist^.concat(new(pai_const,init_16bit(p^.procdefinition^.extnumber)));
  3722.                 end
  3723.               else
  3724.                 emitcall(p^.procdefinition^.mangledname,
  3725.                   p^.symtableproc^.symtabletype=unitsymtable);
  3726.               if ((p^.procdefinition^.options and poclearstack)<>0) then
  3727.                 begin
  3728.                    if (pushedparasize > 0) and (pushedparasize < 9) then
  3729.                      { restore the stack, to its initial value }
  3730.  
  3731. exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,pushedparasize,R_SP)))
  3732.                    else
  3733.                      { restore the stack, to its initial value }
  3734.  
  3735. exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDA,S_L,pushedparasize,R_SP)));
  3736.                 end;
  3737.            end
  3738.          else
  3739.            begin
  3740.               secondpass(p^.right);
  3741.               case p^.right^.location.loc of
  3742.                  LOC_REGISTER,
  3743.                  LOC_CREGISTER : begin
  3744.                                    if p^.right^.location.register in
  3745. [R_D0..R_D7] then
  3746.                                     begin
  3747.                                        reg := getaddressreg;
  3748.  
  3749. emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,reg);
  3750.                                        new(ref);
  3751.                                        reset_reference(ref^);
  3752.                                        ref^.base := reg;
  3753.  
  3754. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
  3755.                                        ungetregister(reg);
  3756.                                     end
  3757.                                    else
  3758.                                     begin
  3759.                                         new(ref);
  3760.                                         reset_reference(ref^);
  3761.                                         ref^.base :=
  3762. p^.right^.location.register;
  3763.  
  3764. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
  3765.                                     end;
  3766.  
  3767. ungetregister32(p^.right^.location.register);
  3768.                                 end
  3769.                  else
  3770.                     begin
  3771.                       if assigned(p^.right^.location.reference.symbol) then
  3772.                       { Here we have a symbolic name to the routine, so
  3773. solve  }
  3774.                       { problem by loading the address first, and then
  3775. emitting }
  3776.                       { the call.
  3777. }
  3778.                        begin
  3779.  
  3780. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  3781.  
  3782. newreference(p^.right^.location.reference),R_A1)));
  3783.                          new(ref);
  3784.                          reset_reference(ref^);
  3785.                          ref^.base := R_A1;
  3786.  
  3787. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
  3788.                        end
  3789.                        else
  3790.                        begin
  3791.  
  3792. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  3793.  
  3794. newreference(p^.right^.location.reference),R_A1)));
  3795.                          new(ref);
  3796.                          reset_reference(ref^);
  3797.                          ref^.base := R_A1;
  3798.  
  3799. exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
  3800.                        end;
  3801.                        del_reference(p^.right^.location.reference);
  3802.                     end;
  3803.               end;
  3804.            end;
  3805.       dont_call:
  3806.          pushedparasize:=oldpushedparasize;
  3807.          unused:=unusedregisters;
  3808.  
  3809.          { handle function results }
  3810.          if p^.resulttype<>pdef(voiddef) then
  3811.            begin
  3812.  
  3813.               { a contructor could be a function with boolean result }
  3814.               if (p^.right=nil) and
  3815.                  ((p^.procdefinition^.options and poconstructor)<>0) and
  3816.                  { quick'n'dirty check if it is a class or an object }
  3817.                  (p^.resulttype^.deftype=orddef) then
  3818.                 begin
  3819.                    p^.location.loc:=LOC_FLAGS;
  3820.                    p^.location.resflags:=F_NE;
  3821.                    if extended_new then
  3822.                      begin
  3823. {$ifdef test_dest_loc}
  3824.                         if dest_loc_known and (dest_loc_tree=p) then
  3825.                           mov_reg_to_dest(p,S_L,R_EAX)
  3826.                         else
  3827. {$endif test_dest_loc}
  3828.                                hregister:=getregister32;
  3829.                                emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  3830.                                p^.location.register:=hregister;
  3831.                      end;
  3832.                 end
  3833.               { structed results are easy to handle.... }
  3834.               else if ret_in_param(p^.resulttype) then
  3835.                 begin
  3836.                    p^.location.loc:=LOC_MEM;
  3837.                    stringdispose(p^.location.reference.symbol);
  3838.                    p^.location.reference:=funcretref;
  3839.                 end
  3840.               else
  3841.                 begin
  3842.                    if (p^.resulttype^.deftype=orddef) then
  3843.                      begin
  3844.                         p^.location.loc:=LOC_REGISTER;
  3845.                   case porddef(p^.resulttype)^.typ of
  3846.                      s32bit,u32bit :
  3847.                         begin
  3848.                              hregister:=getregister32;
  3849.                              emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  3850.                              p^.location.register:=hregister;
  3851.                         end;
  3852.                      uchar,u8bit,bool8bit,s8bit :
  3853.                         begin
  3854.                             hregister:=getregister32;
  3855.                             emit_reg_reg(A_MOVE,S_B,R_D0,hregister);
  3856.                             p^.location.register:=hregister;
  3857.                         end;
  3858.                      s16bit,u16bit :
  3859.                        begin
  3860.                            hregister:=getregister32;
  3861.                            emit_reg_reg(A_MOVE,S_W,R_D0,hregister);
  3862.                            p^.location.register:=hregister;
  3863.                        end;
  3864.                            else internalerror(7);
  3865.                         end
  3866.                      end
  3867.                    else if (p^.resulttype^.deftype=floatdef) then
  3868.                       case pfloatdef(p^.resulttype)^.typ of
  3869.                            f32bit :
  3870.                               begin
  3871.                                 p^.location.loc:=LOC_REGISTER;
  3872.                                 hregister:=getregister32;
  3873.                                 emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  3874.                                 p^.location.register:=hregister;
  3875.                       end;
  3876.                      s32real :  Begin
  3877.                                    p^.location.loc:=LOC_FPU;
  3878.                                    hregister:=getregister32;
  3879.                                    emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  3880.                                    p^.location.fpureg:=hregister;
  3881.                                 end;
  3882.                      s64bit,s64real,s80real: begin
  3883.                                               if cs_fp_emulation in
  3884. aktswitches then
  3885.                                               begin
  3886.                                                 p^.location.loc:=LOC_FPU;
  3887.                                                 hregister:=getregister32;
  3888.  
  3889. emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  3890.  
  3891. p^.location.fpureg:=hregister;
  3892.                                               end
  3893.                                               else
  3894.                                               begin
  3895.                                                 { TRUE FPU mode }
  3896.                                                 p^.location.loc:=LOC_FPU;
  3897.                                                 { on exit of function result
  3898. in R_FP0 }
  3899.                                                 p^.location.fpureg:=R_FP0;
  3900.                                               end;
  3901.                                              end;
  3902.                            else
  3903.                       begin
  3904.                               p^.location.loc:=LOC_FPU;
  3905.                               p^.location.fpureg:=R_FP0;
  3906.                       end;
  3907.              end {end case }
  3908.        else
  3909.         begin
  3910.             p^.location.loc:=LOC_REGISTER;
  3911.             hregister:=getregister32;
  3912.             emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
  3913.             p^.location.register:=hregister;
  3914.                 end;
  3915.            end;
  3916.          end;
  3917.          { perhaps i/o check ? }
  3918.          if iolabel<>nil then
  3919.            begin
  3920.  
  3921. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
  3922.               { this was wrong, probably an error due to diff3
  3923.               emitcall(p^.procdefinition^.mangledname);}
  3924.               emitcall('IOCHECK',true);
  3925.            end;
  3926.  
  3927.          { restore registers }
  3928.          popusedregisters(pushed);
  3929.  
  3930.          { at last, restore instance pointer (SELF) }
  3931.          if loada5 then
  3932.            maybe_loada5;
  3933.          pp:=params;
  3934.          while assigned(pp) do
  3935.            begin
  3936.              if assigned(pp^.left) then
  3937.                if (pp^.left^.location.loc=LOC_REFERENCE) or
  3938.                  (pp^.left^.location.loc=LOC_MEM) then
  3939.                  ungetiftemp(pp^.left^.location.reference);
  3940.                pp:=pp^.right;
  3941.            end;
  3942.          disposetree(params);
  3943.       end;
  3944.  
  3945.     { reverts the parameter list }
  3946.     var nb_para : integer;
  3947.  
  3948.     function reversparameter(p : ptree) : ptree;
  3949.  
  3950.       var
  3951.          hp1,hp2 : ptree;
  3952.  
  3953.       begin
  3954.          hp1:=nil;
  3955.          nb_para := 0;
  3956.          while assigned(p) do
  3957.            begin
  3958.               { pull out }
  3959.               hp2:=p;
  3960.               p:=p^.right;
  3961.               inc(nb_para);
  3962.               { pull in }
  3963.               hp2^.right:=hp1;
  3964.               hp1:=hp2;
  3965.            end;
  3966.          reversparameter:=hp1;
  3967.       end;
  3968.  
  3969.     procedure secondloadvmt(var p : ptree);
  3970.  
  3971.       begin
  3972.          p^.location.loc:=LOC_REGISTER;
  3973.          p^.location.register:=getregister32;
  3974.          exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
  3975.  
  3976. S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
  3977.             p^.location.register)));
  3978.       end;
  3979.  
  3980.     procedure secondinline(var p : ptree);
  3981.     const   in2size:array[in_inc_byte..in_dec_dword] of Topsize=
  3982.                     (S_B,S_W,S_L,S_B,S_W,S_L);
  3983.             in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
  3984.                     (A_ADDQ,A_ADDQ,A_ADDQ,A_SUBQ,A_SUBQ,A_SUBQ);
  3985.             { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
  3986.             float_name: array[tfloattype] of string[8]=
  3987.              {   ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED'); }
  3988.              {  Since we only support the REAL (SINGLE IEEE) FLOAT    }
  3989.              {  type, here is what we do...                           }
  3990.                 ('FIXED','REAL','REAL','REAL','COMP','FIXED');
  3991.       var
  3992.          opsize: topsize;
  3993.          asmop: tasmop;
  3994.  
  3995.          aktfile : treference;
  3996.          ft : tfiletype;
  3997.          pushed : tpushed;
  3998.          dummycoll : tdefcoll;
  3999.  
  4000.       { produces code for READ(LN) and WRITE(LN) }
  4001.  
  4002.       procedure handlereadwrite(doread,callwriteln : boolean);
  4003.  
  4004.         procedure loadstream;
  4005.  
  4006.           const io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
  4007.           var     r : preference;
  4008.  
  4009.           begin
  4010.               new(r);
  4011.               reset_reference(r^);
  4012.  
  4013. r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
  4014.            if assem_need_external_list and not (cs_compilesystem in
  4015. aktswitches) then
  4016.                  concat_external(r^.symbol^,EXT_NEAR);
  4017.  
  4018.               exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,r,R_A0)))
  4019.           end;
  4020.  
  4021.         var
  4022.            node,hp : ptree;
  4023.            typedtyp,pararesult : pdef;
  4024.            doflush,has_length : boolean;
  4025.            dummycoll : tdefcoll;
  4026.            iolabel : plabel;
  4027.            npara : longint;
  4028.  
  4029.         begin
  4030.            { I/O check }
  4031.            if cs_iocheck in aktswitches then
  4032.              begin
  4033.                 getlabel(iolabel);
  4034.                 emitl(A_LABEL,iolabel);
  4035.              end
  4036.            else iolabel:=nil;
  4037.            { no automatic call from flush }
  4038.            doflush:=false;
  4039.            { for write of real with the length specified }
  4040.            has_length:=false;
  4041.            hp:=nil;
  4042.            { reserve temporary pointer to data variable }
  4043.              aktfile.symbol:=nil;
  4044.            gettempofsizereference(4,aktfile);
  4045.            { first state text data }
  4046.            ft:=ft_text;
  4047.            { and state a parameter ? }
  4048.            if p^.left=nil then
  4049.              begin
  4050.                 { state screen address}
  4051.                 doflush:=true;
  4052.                 { the following instructions are for "writeln;" }
  4053.                 loadstream;
  4054.                 { save @Dateivarible in temporary variable }
  4055.  
  4056. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
  4057.              end
  4058.            else
  4059.              begin
  4060.                 { revers paramters }
  4061.                 node:=reversparameter(p^.left);
  4062.  
  4063.                 p^.left := node;
  4064.                 npara := nb_para;
  4065.                 { calculate data variable }
  4066.                 { is first parameter a file type ? }
  4067.                 if node^.left^.resulttype^.deftype=filedef then
  4068.                   begin
  4069.                      ft:=pfiledef(node^.left^.resulttype)^.filetype;
  4070.                      if ft=ft_typed then
  4071.                        typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
  4072.  
  4073.                      secondpass(node^.left);
  4074.                      if codegenerror then
  4075.                        exit;
  4076.  
  4077.                      { save reference in temporary variables }
  4078. { reference in temporäre Variable retten }
  4079.                      if node^.left^.location.loc<>LOC_REFERENCE then
  4080.                        begin
  4081.                           Message(cg_e_illegal_expression);
  4082.                           exit;
  4083.                        end;
  4084.  
  4085. exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_A0)));
  4086.  
  4087.                      { skip to the next parameter }
  4088.                      node:=node^.right;
  4089.                   end
  4090.                 else
  4091.                   begin
  4092.                      { if we write to stdout/in then flush after the
  4093. write(ln) }
  4094.                      doflush:=true;
  4095.                      loadstream;
  4096.                   end;
  4097.  
  4098.                 { save @Dateivarible in temporary variable }
  4099.  
  4100. exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
  4101.                 if doread then
  4102.                   { parameter by READ gives call by reference }
  4103.                   dummycoll.paratyp:=vs_var
  4104.                   { an WRITE Call by "Const" }
  4105.                 else dummycoll.paratyp:=vs_const;
  4106.  
  4107.                 { because of secondcallparan, which otherwise attaches }
  4108.                 if ft=ft_typed then
  4109.                   begin
  4110.                     { this is to avoid copy of simple const parameters }
  4111.                     dummycoll.data:=new(pformaldef,init);
  4112.                      { use var for write also }
  4113.                      { avoids problems with const passed by value }
  4114.                      { but will not accept untyped const }
  4115.                      { dummycoll.paratyp:=vs_var; }
  4116.                   end
  4117.                 else
  4118.                   { I think, this isn't a good solution (FK) }
  4119.                   dummycoll.data:=nil;
  4120.  
  4121.                 while assigned(node) do
  4122.                   begin
  4123.                      pushusedregisters(pushed,$ffff);
  4124.                      hp:=node;
  4125.                           node:=node^.right;
  4126.                      hp^.right:=nil;
  4127.                      if hp^.is_colon_para then
  4128.                        Message(parser_e_illegal_colon_qualifier);
  4129.                      if hp^.is_colon_para then
  4130.                        Message(parser_e_illegal_colon_qualifier);
  4131.                      if ft=ft_typed then
  4132.                        never_copy_const_param:=true;
  4133.                      secondcallparan(hp,@dummycoll,false);
  4134.                      if ft=ft_typed then
  4135.                        never_copy_const_param:=false;
  4136.                      hp^.right:=node;
  4137.                           if codegenerror then
  4138.                        exit;
  4139.  
  4140.                      emit_push_mem(aktfile);
  4141.                           if (ft=ft_typed) then
  4142.                        begin
  4143.                             { OK let's try this }
  4144.                             { first we must only allow the right type }
  4145.                             { we have to call blockread or blockwrite }
  4146.                                    { but the real problem is that
  4147. }
  4148.                             { reset and rewrite should have set       }
  4149.                             { the type size                           }
  4150.                                    { as recordsize for that file !!!!
  4151. }
  4152.                             { how can we make that                    }
  4153.                             { I think that is only possible by adding }
  4154.                             { reset and rewrite to the inline list a call
  4155. }
  4156.                                    { allways read only one record by element
  4157. }
  4158.                             push_int(typedtyp^.size);
  4159.                             if doread then
  4160.                                      emitcall('TYPED_READ',true)
  4161.                                 else
  4162.                                      emitcall('TYPED_WRITE',true)
  4163.                           {!!!!!!!}
  4164.                        end
  4165.                      else
  4166.                        begin
  4167.                           { save current position }
  4168.                           pararesult:=hp^.left^.resulttype;
  4169.                           { handle possible field width  }
  4170.                           { of course only for write(ln) }
  4171.                           if not doread then
  4172.                                  begin
  4173.                                 { handle total width parameter }
  4174.                                if assigned(node) and node^.is_colon_para
  4175. then
  4176.                                  begin
  4177.                                     hp:=node;
  4178.                                     node:=node^.right;
  4179.                                     hp^.right:=nil;
  4180.  
  4181. secondcallparan(hp,@dummycoll,false);
  4182.                                     hp^.right:=node;
  4183.                                              if codegenerror then
  4184.                                       exit;
  4185.                                     has_length:=true;
  4186.                                  end
  4187.                                else
  4188.                                if pararesult^.deftype<>floatdef then
  4189.                                  push_int(0)
  4190.                                else
  4191.                                  push_int(-32767);
  4192.                               { a second colon para for a float ? }
  4193.                               if assigned(node) and node^.is_colon_para then
  4194.                                       begin
  4195.                                     hp:=node;
  4196.                                     node:=node^.right;
  4197.                                              hp^.right:=nil;
  4198.                                     secondcallparan(hp,@dummycoll,false);
  4199.                                              hp^.right:=node;
  4200.                                     if pararesult^.deftype<>floatdef then
  4201.  
  4202. Message(parser_e_illegal_colon_qualifier);
  4203.                                     if codegenerror then
  4204.                                       exit;
  4205.                               end
  4206.                                      else
  4207.                               begin
  4208.                                 if hp^.left^.resulttype^.deftype=floatdef
  4209. then
  4210.                                   push_int(-1);
  4211.                               end;
  4212.                             end;
  4213.                           case pararesult^.deftype of
  4214.                               stringdef : begin
  4215.                                             if doread then
  4216.  
  4217. emitcall('READ_TEXT_STRING',true)
  4218.                                             else
  4219.                                               begin
  4220.  
  4221. emitcall('WRITE_TEXT_STRING',true);
  4222.  
  4223. {ungetiftemp(hp^.left^.location.reference);}
  4224.                                    end;
  4225.                                          end;
  4226.                              pointerdef : begin
  4227.                                              if
  4228. is_equal(ppointerdef(pararesult)^.definition,cchardef) then
  4229.                                                begin
  4230.                                                   if doread then
  4231.  
  4232. emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
  4233.                                                   else
  4234.  
  4235. emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
  4236.                                                end
  4237.                                              else
  4238. Message(parser_e_illegal_parameter_list);
  4239.                                           end;
  4240.                              arraydef : begin
  4241.                                            if
  4242. (parraydef(pararesult)^.lowrange=0)
  4243.                                              and
  4244. is_equal(parraydef(pararesult)^.definition,cchardef) then
  4245.                                              begin
  4246.                                                 if doread then
  4247.  
  4248. emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
  4249.                                                 else
  4250.  
  4251. emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
  4252.                                              end
  4253.                                            else
  4254. Message(parser_e_illegal_parameter_list);
  4255.                                         end;
  4256.                       floatdef : begin
  4257.                                       if doread then
  4258.                                           emitcall('READ_TEXT_REAL',true)
  4259.                                       else
  4260.  
  4261. emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
  4262.                                  end;
  4263.                       orddef : begin
  4264.                                 case porddef(pararesult)^.typ of
  4265.                                    u8bit : if doread then
  4266.  
  4267. emitcall('READ_TEXT_BYTE',true);
  4268.                                    s8bit : if doread then
  4269.  
  4270. emitcall('READ_TEXT_SHORTINT',true);
  4271.                                    u16bit : if doread then
  4272.  
  4273. emitcall('READ_TEXT_WORD',true);
  4274.                                    s16bit : if doread then
  4275.  
  4276. emitcall('READ_TEXT_INTEGER',true);
  4277.                                    s32bit : if doread then
  4278.  
  4279. emitcall('READ_TEXT_LONGINT',true)
  4280.                                             else
  4281.  
  4282. emitcall('WRITE_TEXT_LONGINT',true);
  4283.                                    u32bit : if doread then
  4284.  
  4285. emitcall('READ_TEXT_CARDINAL',true)
  4286.                                             else
  4287.  
  4288. emitcall('WRITE_TEXT_CARDINAL',true);
  4289.                                    uchar : if doread then
  4290.  
  4291. emitcall('READ_TEXT_CHAR',true)
  4292.                                            else
  4293.  
  4294. emitcall('WRITE_TEXT_CHAR',true);
  4295.                                    bool8bit : if  doread then
  4296.                                                {
  4297. emitcall('READ_TEXT_BOOLEAN',true) }
  4298.  
  4299. Message(parser_e_illegal_parameter_list)
  4300.                                               else
  4301.  
  4302. emitcall('WRITE_TEXT_BOOLEAN',true);
  4303.                                    else
  4304. Message(parser_e_illegal_parameter_list);
  4305.                                 end;
  4306.                              end;
  4307.                              else Message(parser_e_illegal_parameter_list);
  4308.                           end;
  4309.                        end;
  4310.                      { load A5 in methods again }
  4311.                      popusedregisters(pushed);
  4312.                      maybe_loada5;
  4313.                   end;
  4314.              end;
  4315.            if callwriteln then
  4316.              begin
  4317.                 pushusedregisters(pushed,$ffff);
  4318.                 emit_push_mem(aktfile);
  4319.                 { pushexceptlabel; }
  4320.                 if ft<>ft_text then
  4321.                   Message(parser_e_illegal_parameter_list);
  4322.                      emitcall('WRITELN_TEXT',true);
  4323.                      popusedregisters(pushed);
  4324.                      maybe_loada5;
  4325.                  end;
  4326.            if doflush and not(doread) then
  4327.              begin
  4328.                pushusedregisters(pushed,$ffff);
  4329.                { pushexceptlabel; }
  4330.                emitcall('FLUSH_STDOUT',true);
  4331.                popusedregisters(pushed);
  4332.                maybe_loada5;
  4333.              end;
  4334.            if iolabel<>nil then
  4335.              begin
  4336.                 { registers are saved in the procedure }
  4337.  
  4338. exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
  4339.                 emitcall('IOCHECK',true);
  4340.              end;
  4341.            ungetiftemp(aktfile);
  4342.            if assigned(p^.left) then
  4343.              begin
  4344.                 p^.left:=reversparameter(p^.left);
  4345.                 if npara<>nb_para then
  4346.                  Message(cg_f_internal_error_in_secondinline);
  4347.                 hp:=p^.left;
  4348.                 while assigned(hp) do
  4349.                   begin
  4350.                      if assigned(hp^.left) then
  4351.                        if (hp^.left^.location.loc=LOC_REFERENCE) or
  4352.                          (hp^.left^.location.loc=LOC_MEM) then
  4353.                          ungetiftemp(hp^.left^.location.reference);
  4354.                      hp:=hp^.right;
  4355.                   end;
  4356.             end;
  4357.         end;
  4358.  
  4359.       procedure handle_str;
  4360.  
  4361.         var
  4362.            hp,node,lentree,paratree : ptree;
  4363.            dummycoll : tdefcoll;
  4364.            is_real,has_length : boolean;
  4365.            real_type : byte;
  4366.  
  4367.           begin
  4368.            pushusedregisters(pushed,$ffff);
  4369.            node:=p^.left;
  4370.            is_real:=false;
  4371.            has_length:=false;
  4372.            while assigned(node^.right) do node:=node^.right;
  4373.            { if a real parameter somewhere then call REALSTR }
  4374.            if (node^.left^.resulttype^.deftype=floatdef) then
  4375.              is_real:=true;
  4376.  
  4377.            node:=p^.left;
  4378.            { we have at least two args }
  4379.            { with at max 2 colon_para in between }
  4380.  
  4381.            { first arg longint or float }
  4382.            hp:=node;
  4383.            node:=node^.right;
  4384.            hp^.right:=nil;
  4385.            dummycoll.data:=hp^.resulttype;
  4386.            { string arg }
  4387.  
  4388.            dummycoll.paratyp:=vs_var;
  4389.            secondcallparan(hp,@dummycoll,false);
  4390.            if codegenerror then
  4391.              exit;
  4392.  
  4393.            dummycoll.paratyp:=vs_const;
  4394.            { second arg }
  4395.            hp:=node;
  4396.            node:=node^.right;
  4397.            hp^.right:=nil;
  4398.            { frac  para }
  4399.            if hp^.is_colon_para and assigned(node) and
  4400.               node^.is_colon_para then
  4401.              begin
  4402.                 dummycoll.data:=hp^.resulttype;
  4403.                 secondcallparan(hp,@dummycoll,false);
  4404.                 if codegenerror then
  4405.                   exit;
  4406.                 hp:=node;
  4407.                 node:=node^.right;
  4408.                 hp^.right:=nil;
  4409.                 has_length:=true;
  4410.              end
  4411.            else
  4412.              if is_real then
  4413.              push_int(-1);
  4414.  
  4415.            { third arg, length only if is_real }
  4416.            if hp^.is_colon_para then
  4417.              begin
  4418.                 dummycoll.data:=hp^.resulttype;
  4419.                 secondcallparan(hp,@dummycoll,false);
  4420.                 if codegenerror then
  4421.                   exit;
  4422.                 hp:=node;
  4423.                 node:=node^.right;
  4424.                 hp^.right:=nil;
  4425.              end
  4426.            else
  4427.              if is_real then
  4428.                push_int(-32767)
  4429.              else
  4430.                push_int(-1);
  4431.  
  4432.            { last arg longint or real }
  4433.            secondcallparan(hp,@dummycoll,false);
  4434.            if codegenerror then
  4435.              exit;
  4436.  
  4437.            if is_real then
  4438.  
  4439. emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
  4440.            else if porddef(hp^.resulttype)^.typ=u32bit then
  4441.              emitcall('STR_CARDINAL',true)
  4442.            else
  4443.              emitcall('STR_LONGINT',true);
  4444.            popusedregisters(pushed);
  4445.         end;
  4446.  
  4447.       var
  4448.          r : preference;
  4449.  
  4450.       begin
  4451.          case p^.inlinenumber of
  4452.             in_lo_word,
  4453.             in_hi_word : begin
  4454.                        secondpass(p^.left);
  4455.                        p^.location.loc:=LOC_REGISTER;
  4456.                        if p^.left^.location.loc<>LOC_REGISTER then
  4457.                          begin
  4458.                             if p^.left^.location.loc=LOC_CREGISTER then
  4459.                               begin
  4460.                                  p^.location.register:=getregister32;
  4461.  
  4462. emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,
  4463.                                    p^.location.register);
  4464.                               end
  4465.                             else
  4466.                               begin
  4467.                                  del_reference(p^.left^.location.reference);
  4468.                                  p^.location.register:=getregister32;
  4469.  
  4470. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  4471.                                   newreference(p^.left^.location.reference),
  4472.                                   p^.location.register)));
  4473.                               end;
  4474.                          end
  4475.                        else
  4476. p^.location.register:=p^.left^.location.register;
  4477.                        if p^.inlinenumber=in_hi_word then
  4478.  
  4479. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSR,S_W,8,p^.location.register)));
  4480.                        p^.location.register:=p^.location.register;
  4481.                     end;
  4482.             in_high_x :
  4483.               begin
  4484.                  if is_open_array(p^.left^.resulttype) then
  4485.                    begin
  4486.                       secondpass(p^.left);
  4487.                       del_reference(p^.left^.location.reference);
  4488.                       p^.location.register:=getregister32;
  4489.                       new(r);
  4490.                       reset_reference(r^);
  4491.                       r^.base:=highframepointer;
  4492.                       r^.offset:=highoffset+4;
  4493.                       exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  4494.                         r,p^.location.register)));
  4495.                    end
  4496.               end;
  4497.           in_sizeof_x,
  4498.           in_typeof_x:
  4499.                 begin
  4500.                    { load vmt }
  4501.                    if p^.left^.treetype=typen then
  4502.                      begin
  4503.                       exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,
  4504.  
  4505. S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
  4506.                         R_A0)));
  4507.                       p^.location.register:=getregister32;
  4508.                       emit_reg_reg(A_MOVE,S_L,R_A0,p^.location.register);
  4509.                      end
  4510.                    else
  4511.                      begin
  4512.                         secondpass(p^.left);
  4513.                         del_reference(p^.left^.location.reference);
  4514.                         p^.location.loc:=LOC_REGISTER;
  4515.                         p^.location.register:=getregister32;
  4516.                         { load VMT pointer }
  4517.  
  4518. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  4519.                           newreference(p^.left^.location.reference),
  4520.                           p^.location.register)));
  4521.                      end;
  4522.  
  4523.                    { in sizeof load size }
  4524.                    if p^.inlinenumber=in_sizeof_x then
  4525.                      begin
  4526.                         new(r);
  4527.                         reset_reference(r^);
  4528.                         { load the address in A0 }
  4529.                         { because now supposedly p^.location.register is an
  4530. }
  4531.                         { address.
  4532. }
  4533.                         emit_reg_reg(A_MOVE, S_L, p^.location.register,
  4534. R_A0);
  4535.                         r^.base:=R_A0;
  4536.  
  4537. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,
  4538.                           p^.location.register)));
  4539.                      end;
  4540.                 end;
  4541.             in_lo_long,
  4542.             in_hi_long : begin
  4543.                        secondpass(p^.left);
  4544.                        p^.location.loc:=LOC_REGISTER;
  4545.                        if p^.left^.location.loc<>LOC_REGISTER then
  4546.                          begin
  4547.                             if p^.left^.location.loc=LOC_CREGISTER then
  4548.                               begin
  4549.                                  p^.location.register:=getregister32;
  4550.  
  4551. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
  4552.                                    p^.location.register);
  4553.                               end
  4554.                             else
  4555.                               begin
  4556.                                  del_reference(p^.left^.location.reference);
  4557.                                  p^.location.register:=getregister32;
  4558.  
  4559. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  4560.                                   newreference(p^.left^.location.reference),
  4561.                                   p^.location.register)));
  4562.                               end;
  4563.                          end
  4564.                        else
  4565. p^.location.register:=p^.left^.location.register;
  4566.                        if p^.inlinenumber=in_hi_long then
  4567.                          begin
  4568.  
  4569. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ, S_L, 16, R_D1)));
  4570.  
  4571. exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSR,S_L,R_D1,p^.location.register)));
  4572.                          end;
  4573.                        p^.location.register:=p^.location.register;
  4574.                     end;
  4575. {We can now comment them out, as they are handled as typecast.
  4576.  Saves an incredible amount of 8 bytes code.
  4577.   I'am not lucky about this, because it's _not_ a type cast (FK) }
  4578. {           in_ord_char,
  4579.             in_chr_byte,}
  4580.             in_length_string : begin
  4581.                        secondpass(p^.left);
  4582.                        set_location(p^.location,p^.left^.location);
  4583.                     end;
  4584.             in_inc_byte..in_dec_dword:
  4585.                 begin
  4586.                     secondpass(p^.left);
  4587.  
  4588. exprasmlist^.concat(new(pai68k,op_const_ref(in2instr[p^.inlinenumber],
  4589.  
  4590. in2size[p^.inlinenumber],1,newreference(p^.left^.location.reference))));
  4591.                      emitoverflowcheck(p^.left);
  4592.                 end;
  4593.             in_pred_x,
  4594.             in_succ_x:
  4595.               begin
  4596.                  secondpass(p^.left);
  4597.                  if p^.inlinenumber=in_pred_x then
  4598.                    asmop:=A_SUB
  4599.                  else
  4600.                    asmop:=A_ADD;
  4601.                  case p^.resulttype^.size of
  4602.                    4 : opsize:=S_L;
  4603.                    2 : opsize:=S_W;
  4604.                    1 : opsize:=S_B;
  4605.                  else
  4606.                     internalerror(10080);
  4607.                  end;
  4608.                  p^.location.loc:=LOC_REGISTER;
  4609.                  if p^.left^.location.loc<>LOC_REGISTER then
  4610.                    begin
  4611.                       p^.location.register:=getregister32;
  4612.                       if p^.left^.location.loc=LOC_CREGISTER then
  4613.  
  4614. emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
  4615.                           p^.location.register)
  4616.                       else
  4617.                       if p^.left^.location.loc=LOC_FLAGS then
  4618.  
  4619. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
  4620.                                   p^.location.register)))
  4621.                       else
  4622.                         begin
  4623.                            del_reference(p^.left^.location.reference);
  4624.  
  4625. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.left^.location.reference),
  4626.                              p^.location.register)));
  4627.                         end;
  4628.                    end
  4629.                  else p^.location.register:=p^.left^.location.register;
  4630.                  exprasmlist^.concat(new(pai68k,op_const_reg(asmop,opsize,1,
  4631.                    p^.location.register)))
  4632.                  { here we should insert bounds check ? }
  4633.                  { and direct call to bounds will crash the program }
  4634.                  { if we are at the limit }
  4635.                  { we could also simply say that pred(first)=first and
  4636. succ(last)=last }
  4637.                  { could this be usefull I don't think so (PM)
  4638.                  emitoverflowcheck;}
  4639.               end;
  4640.  
  4641.         in_assigned_x:
  4642.               begin
  4643.          secondpass(p^.left^.left);
  4644.          p^.location.loc:=LOC_FLAGS;
  4645.          if (p^.left^.left^.location.loc=LOC_REGISTER) or
  4646.            (p^.left^.left^.location.loc=LOC_CREGISTER) then
  4647.            begin
  4648.               exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,
  4649.                 p^.left^.left^.location.register)));
  4650.               ungetregister32(p^.left^.left^.location.register);
  4651.            end
  4652.          else
  4653.            begin
  4654.               exprasmlist^.concat(new(pai68k,op_ref(A_TST,S_L,
  4655.               newreference(p^.left^.left^.location.reference))));
  4656.               del_reference(p^.left^.left^.location.reference);
  4657.            end;
  4658.          p^.location.resflags:=F_NE;
  4659.           end;
  4660.              in_reset_typedfile,in_rewrite_typedfile :
  4661.                begin
  4662.                   pushusedregisters(pushed,$ffff);
  4663.                   exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,
  4664.  
  4665. pfiledef(p^.left^.resulttype)^.typed_as^.size,R_SPPUSH)));
  4666.                   secondload(p^.left);
  4667.                   emitpushreferenceaddr(p^.left^.location.reference);
  4668.                   if p^.inlinenumber=in_reset_typedfile then
  4669.                     emitcall('RESET_TYPED',true)
  4670.                   else
  4671.                     emitcall('REWRITE_TYPED',true);
  4672.                   popusedregisters(pushed);
  4673.                end;
  4674.             in_write_x :
  4675.               handlereadwrite(false,false);
  4676.             in_writeln_x :
  4677.               handlereadwrite(false,true);
  4678.             in_read_x :
  4679.               handlereadwrite(true,false);
  4680.             in_readln_x :
  4681.               begin
  4682.                    handlereadwrite(true,false);
  4683.                    pushusedregisters(pushed,$ffff);
  4684.                    emit_push_mem(aktfile);
  4685.                    { pushexceptlabel; }
  4686.                    if ft<>ft_text then
  4687.                      Message(parser_e_illegal_parameter_list);
  4688.                        emitcall('READLN_TEXT',true);
  4689.                        popusedregisters(pushed);
  4690.                    maybe_loada5;
  4691.                 end;
  4692.             in_str_x_string : begin
  4693.                                  handle_str;
  4694.                                  maybe_loada5;
  4695.                               end;
  4696.             else internalerror(9);
  4697.          end;
  4698.       end;
  4699.  
  4700.     procedure secondsubscriptn(var p : ptree);
  4701.       var
  4702.        hr: tregister;
  4703.  
  4704.       begin
  4705.  
  4706.          secondpass(p^.left);
  4707.  
  4708.          if codegenerror then
  4709.            exit;
  4710.          { classes must be dereferenced implicit }
  4711.          if (p^.left^.resulttype^.deftype=objectdef) and
  4712.            pobjectdef(p^.left^.resulttype)^.isclass then
  4713.            begin
  4714.              clear_reference(p^.location.reference);
  4715.              case p^.left^.location.loc of
  4716.                 LOC_REGISTER:
  4717.                   begin
  4718.                      { move it to an address register...}
  4719.                      hr:=getaddressreg;
  4720.                      emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  4721.                      p^.location.reference.base:=hr;
  4722.                      { free register }
  4723.                      ungetregister(p^.left^.location.register);
  4724.                   end;
  4725.                 LOC_CREGISTER:
  4726.                   begin
  4727.                      { ... and reserve one for the pointer }
  4728.                      hr:=getaddressreg;
  4729.                      emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
  4730.                        p^.location.reference.base:=hr;
  4731.                   end;
  4732.                 else
  4733.                   begin
  4734.                      { free register }
  4735.                      del_reference(p^.left^.location.reference);
  4736.  
  4737.                      { ... and reserve one for the pointer }
  4738.                      hr:=getaddressreg;
  4739.                      exprasmlist^.concat(new(pai68k,op_ref_reg(
  4740.                        A_MOVE,S_L,newreference(p^.left^.location.reference),
  4741.                        hr)));
  4742.                      p^.location.reference.base:=hr;
  4743.                   end;
  4744.              end;
  4745.            end
  4746.          else
  4747.            set_location(p^.location,p^.left^.location);
  4748.  
  4749.          inc(p^.location.reference.offset,p^.vs^.address);
  4750.       end;
  4751.  
  4752.     procedure secondselfn(var p : ptree);
  4753.  
  4754.       begin
  4755.          clear_reference(p^.location.reference);
  4756.          p^.location.reference.base:=R_A5;
  4757.       end;
  4758.  
  4759.     procedure secondhdisposen(var p : ptree);
  4760.  
  4761.       begin
  4762.          secondpass(p^.left);
  4763.  
  4764.          if codegenerror then
  4765.            exit;
  4766.          clear_reference(p^.location.reference);
  4767.          case p^.left^.location.loc of
  4768.             LOC_REGISTER,
  4769.             LOC_CREGISTER : begin
  4770.                                p^.location.reference.base:=getaddressreg;
  4771.  
  4772. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  4773.                                  p^.left^.location.register,
  4774.                                  p^.location.reference.base)));
  4775.                             end;
  4776.             LOC_MEM,LOC_REFERENCE :
  4777.                             begin
  4778.                                del_reference(p^.left^.location.reference);
  4779.                                p^.location.reference.base:=getaddressreg;
  4780.  
  4781. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
  4782.                                  p^.location.reference.base)));
  4783.                             end;
  4784.          end;
  4785.       end;
  4786.  
  4787.     procedure secondhnewn(var p : ptree);
  4788.  
  4789.       begin
  4790.       end;
  4791.  
  4792.     procedure secondnewn(var p : ptree);
  4793.  
  4794.       begin
  4795.          secondpass(p^.left);
  4796.  
  4797.          if codegenerror then
  4798.            exit;
  4799.  
  4800.          p^.location.register:=p^.left^.location.register;
  4801.       end;
  4802.  
  4803.     procedure secondsimplenewdispose(var p : ptree);
  4804.  
  4805.       var
  4806.          pushed : tpushed;
  4807.       begin
  4808.          secondpass(p^.left);
  4809.          if codegenerror then
  4810.            exit;
  4811.  
  4812.          pushusedregisters(pushed,$ffff);
  4813.          { determines the size of the mem block }
  4814.          push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
  4815.  
  4816.          { push pointer adress }
  4817.          case p^.left^.location.loc of
  4818.             LOC_CREGISTER :
  4819. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  4820.               p^.left^.location.register,R_SPPUSH)));
  4821.             LOC_REFERENCE :
  4822. emitpushreferenceaddr(p^.left^.location.reference);
  4823.  
  4824.          end;
  4825.  
  4826.          { call the mem handling procedures }
  4827.          case p^.treetype of
  4828.             simpledisposen :
  4829.                 emitcall('FREEMEM',true);
  4830.             simplenewn :
  4831.                 emitcall('GETMEM',true);
  4832.          end;
  4833.  
  4834.        popusedregisters(pushed);
  4835.          { may be load ESI }
  4836.          maybe_loada5;
  4837.       end;
  4838.  
  4839.     procedure secondsetcons(var p : ptree);
  4840.  
  4841.       var
  4842.          l : plabel;
  4843.          i,smallsetvalue : longint;
  4844.          hp : ptree;
  4845.          href,sref : treference;
  4846.          hl1,hl2: plabel;
  4847.          j: byte;
  4848.  
  4849.       begin
  4850.          { this should be reimplemented for smallsets }
  4851.          { differently  (PM) }
  4852.          { produce constant part }
  4853.          j:=0;
  4854.          href.symbol := Nil;
  4855.          clear_reference(href);
  4856.          { alignment required for m68k }
  4857.          datasegment^.concat(new(pai_align,init(4)));
  4858.          getlabel(l);
  4859.          href.symbol:=stringdup(lab2str(l));
  4860.          stringdispose(p^.location.reference.symbol);
  4861.          datasegment^.concat(new(pai_label,init(l)));
  4862.            {if psetdef(p^.resulttype)=smallset then
  4863.            begin
  4864.               smallsetvalue:=(p^.constset^[3]*256)+p^.constset^[2];
  4865.  
  4866. smallsetvalue:=((smallset*256+p^.constset^[1])*256+p^.constset^[1];
  4867.               datasegment^.concat(new(pai_const,init_32bit(smallsetvalue)));
  4868.               hp:=p^.left;
  4869.               if assigned(hp) then
  4870.                 begin
  4871.                    sref.symbol:=nil;
  4872.                    gettempofsizereference(32,sref);
  4873.                      concatcopy(href,sref,32,false);
  4874.                    while assigned(hp) do
  4875.                      begin
  4876.                         secondpass(hp^.left);
  4877.                         if codegenerror then
  4878.                           exit;
  4879.  
  4880.                         pushsetelement(hp^.left);
  4881.                         emitpushreferenceaddr(sref);
  4882.                          register is save in subroutine
  4883.                         emitcall('SET_SET_BYTE',true);
  4884.                         hp:=hp^.right;
  4885.                      end;
  4886.                    p^.location.reference:=sref;
  4887.                 end
  4888.               else p^.location.reference:=href;
  4889.            end
  4890.          else    }
  4891.            begin
  4892.              for i:=0 to (31 div 4) do
  4893.              Begin
  4894.          { This is required because of the ENDIAN of m68k machines }
  4895.  
  4896. datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+3])));
  4897.  
  4898. datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+2])));
  4899.  
  4900. datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+1])));
  4901.  
  4902. datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j])));
  4903.                Inc(j,4);
  4904. {
  4905. datasegment^.concat(new(pai_const,init_8bit(p^.constset^[i])));}
  4906.              end;
  4907.              hp:=p^.left;
  4908.              if assigned(hp) then
  4909.              begin
  4910.                 sref.symbol:=nil;
  4911.                 gettempofsizereference(32,sref);
  4912.                 concatcopy(href,sref,32,false);
  4913.                 while assigned(hp) do
  4914.                   begin
  4915.                      secondpass(hp^.left);
  4916.                      if codegenerror then
  4917.                        exit;
  4918.  
  4919.                      loadsetelement(hp^.left);
  4920.                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  4921.                      newreference(sref),R_A0)));;
  4922. {                   emitpushreferenceaddr(sref); }
  4923.                    { register is save in subroutine }
  4924.                      emitcall('SET_SET_BYTE',true);
  4925.                      hp:=hp^.right;
  4926.                  end;
  4927.                 p^.location.reference:=sref;
  4928.              end
  4929.              else
  4930.                 p^.location.reference:=href;
  4931.            end;
  4932.       end;
  4933.  
  4934.     procedure secondcontinuen(var p : ptree);
  4935.  
  4936.       begin
  4937.          if aktcontinuelabel<>nil then
  4938.            emitl(A_JMP,aktcontinuelabel)
  4939.          else
  4940.            Message(cg_e_continue_not_allowed);
  4941.       end;
  4942.  
  4943. {    var
  4944.        hs : string; }
  4945.  
  4946.     procedure secondexitn(var p : ptree);
  4947.  
  4948.       var
  4949.          is_mem : boolean;
  4950.          {op : tasmop;
  4951.          s : topsize;}
  4952.          otlabel,oflabel : plabel;
  4953.  
  4954.       label
  4955.          do_jmp;
  4956.  
  4957.       begin
  4958.          if assigned(p^.left) then
  4959.            begin
  4960.               otlabel:=truelabel;
  4961.               oflabel:=falselabel;
  4962.               getlabel(truelabel);
  4963.               getlabel(falselabel);
  4964.               secondpass(p^.left);
  4965.               case p^.left^.location.loc of
  4966.                  LOC_FPU : goto do_jmp;
  4967.                  LOC_MEM,LOC_REFERENCE : is_mem:=true;
  4968.                  LOC_CREGISTER,
  4969.                  LOC_REGISTER : is_mem:=false;
  4970.                  LOC_FLAGS : begin
  4971.  
  4972. exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,R_D0)));
  4973.                                 exprasmlist^.concat(new(pai68k,op_reg(A_NEG,
  4974. S_B, R_D0)));
  4975.                                 goto do_jmp;
  4976.                              end;
  4977.                  LOC_JUMP : begin
  4978.                                emitl(A_LABEL,truelabel);
  4979.  
  4980. exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,1,R_D0)));
  4981.                                emitl(A_JMP,aktexit2label);
  4982.  
  4983. exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,R_D0)));
  4984.                                goto do_jmp;
  4985.                             end;
  4986.                  else internalerror(2001);
  4987.               end;
  4988.               if (procinfo.retdef^.deftype=orddef) then
  4989.                 begin
  4990.                    case porddef(procinfo.retdef)^.typ of
  4991.                       s32bit,u32bit : if is_mem then
  4992.  
  4993. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  4994.  
  4995. newreference(p^.left^.location.reference),R_D0)))
  4996.                                       else
  4997.                                         emit_reg_reg(A_MOVE,S_L,
  4998.                                           p^.left^.location.register,R_D0);
  4999.                       u8bit,s8bit,uchar,bool8bit : if is_mem then
  5000.  
  5001. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
  5002.  
  5003. newreference(p^.left^.location.reference),R_D0)))
  5004.                                       else
  5005.                                         emit_reg_reg(A_MOVE,S_B,
  5006.                                           p^.left^.location.register,R_D0);
  5007.                       s16bit,u16bit : if is_mem then
  5008.  
  5009. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
  5010.  
  5011. newreference(p^.left^.location.reference),R_D0)))
  5012.                                       else
  5013.                                         emit_reg_reg(A_MOVE,S_W,
  5014.                                           p^.left^.location.register,R_D0);
  5015.                    end;
  5016.                 end
  5017.                else
  5018.                  if (procinfo.retdef^.deftype in
  5019.                      [pointerdef,enumdef,procvardef]) then
  5020.                    begin
  5021.                       if is_mem then
  5022.  
  5023. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  5024.                           newreference(p^.left^.location.reference),R_D0)))
  5025.                       else
  5026.  
  5027. exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
  5028.                           p^.left^.location.register,R_D0)));
  5029.                    end
  5030.               else
  5031.                 if (procinfo.retdef^.deftype=floatdef) then
  5032.             { floating point return values .... }
  5033.             { single are returned in d0         }
  5034.                   begin
  5035.                      if (pfloatdef(procinfo.retdef)^.typ=f32bit) or
  5036.                         (pfloatdef(procinfo.retdef)^.typ=s32real) then
  5037.                        begin
  5038.                           if is_mem then
  5039.  
  5040. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
  5041.  
  5042. newreference(p^.left^.location.reference),R_D0)))
  5043.                           else
  5044.                             begin
  5045.                                if pfloatdef(procinfo.retdef)^.typ=f32bit
  5046. then
  5047.  
  5048. emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0)
  5049.                                else
  5050.                                   begin
  5051.                                      { single values are in the floating
  5052. point registers }
  5053.                                      if cs_fp_emulation in aktswitches then
  5054.  
  5055. emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)
  5056.                                      else
  5057.  
  5058. exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_S,
  5059.                                            p^.left^.location.fpureg,R_D0)));
  5060.                                   end;
  5061.                             end;
  5062.                        end
  5063.                      else
  5064.                        Begin
  5065.                          { this is only possible in real non emulation mode
  5066. }
  5067.                          { LOC_MEM,LOC_REFERENCE }
  5068.                          if is_mem then
  5069.                            begin
  5070.  
  5071. exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
  5072.  
  5073. getfloatsize(pfloatdef(procinfo.retdef)^.typ),
  5074.  
  5075. newreference(p^.left^.location.reference),R_FP0)));
  5076.                            end
  5077.                          else
  5078.                           { LOC_FPU }
  5079.                             begin
  5080.                                { convert from extended to correct type }
  5081.                                { when storing                          }
  5082.  
  5083. exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
  5084.  
  5085. getfloatsize(pfloatdef(procinfo.retdef)^.typ),p^.left^.location.fpureg,R_FP0)));
  5086.                             end;
  5087.                        end;
  5088.               end;
  5089. do_jmp:
  5090.               truelabel:=otlabel;
  5091.               falselabel:=oflabel;
  5092.               emitl(A_JMP,aktexit2label);
  5093.            end
  5094.          else
  5095.            begin
  5096.               emitl(A_JMP,aktexitlabel);
  5097.            end;
  5098.       end;
  5099.  
  5100.     procedure secondgoto(var p : ptree);
  5101.  
  5102.       begin
  5103.          emitl(A_JMP,p^.labelnr);
  5104.       end;
  5105.  
  5106.     procedure secondlabel(var p : ptree);
  5107.  
  5108.       begin
  5109.          emitl(A_LABEL,p^.labelnr);
  5110.          cleartempgen;
  5111.          secondpass(p^.left);
  5112.       end;
  5113.  
  5114.     procedure secondasm(var p : ptree);
  5115.  
  5116.       begin
  5117.          exprasmlist^.concatlist(p^.p_asm);
  5118.       end;
  5119.  
  5120.     procedure secondcase(var p : ptree);
  5121.  
  5122.       var
  5123.          with_sign : boolean;
  5124.          opsize : topsize;
  5125.          jmp_gt,jmp_le,jmp_lee : tasmop;
  5126.          hp : ptree;
  5127.          { register with case expression }
  5128.          hregister : tregister;
  5129.          endlabel,elselabel : plabel;
  5130.  
  5131.          { true, if we can omit the range check of the jump table }
  5132.          jumptable_no_range : boolean;
  5133.  
  5134.       procedure gentreejmp(p : pcaserecord);
  5135.  
  5136.         var
  5137.            lesslabel,greaterlabel : plabel;
  5138.  
  5139.       begin
  5140.          emitl(A_LABEL,p^._at);
  5141.          { calculate labels for left and right }
  5142.          if (p^.less=nil) then
  5143.            lesslabel:=elselabel
  5144.          else
  5145.            lesslabel:=p^.less^._at;
  5146.          if (p^.greater=nil) then
  5147.            greaterlabel:=elselabel
  5148.          else
  5149.            greaterlabel:=p^.greater^._at;
  5150.            { calculate labels for left and right }
  5151.          { no range label: }
  5152.          if p^._low=p^._high then
  5153.            begin
  5154.  
  5155. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  5156.               if greaterlabel=lesslabel then
  5157.                 begin
  5158.                    emitl(A_BNE,lesslabel);
  5159.                 end
  5160.               else
  5161.                 begin
  5162.                    emitl(jmp_le,lesslabel);
  5163.                    emitl(jmp_gt,greaterlabel);
  5164.                 end;
  5165.               emitl(A_JMP,p^.statement);
  5166.            end
  5167.          else
  5168.            begin
  5169.  
  5170. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
  5171.               emitl(jmp_le,lesslabel);
  5172.  
  5173. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._high,hregister)));
  5174.               emitl(jmp_gt,greaterlabel);
  5175.               emitl(A_JMP,p^.statement);
  5176.            end;
  5177.          if assigned(p^.less) then
  5178.            gentreejmp(p^.less);
  5179.          if assigned(p^.greater) then
  5180.            gentreejmp(p^.greater);
  5181.       end;
  5182.  
  5183.       procedure genlinearlist(hp : pcaserecord);
  5184.  
  5185.         var
  5186.            first : boolean;
  5187.            last : longint;
  5188.  
  5189.         procedure genitem(t : pcaserecord);
  5190.  
  5191.           begin
  5192.              if assigned(t^.less) then
  5193.                genitem(t^.less);
  5194.              if t^._low=t^._high then
  5195.                begin
  5196.                   if (t^._low-last > 0) and (t^._low-last < 9) then
  5197.  
  5198. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last,hregister)))
  5199.                   else
  5200.                   if (t^._low-last = 0) then
  5201.  
  5202. exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
  5203.                   else
  5204.  
  5205. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
  5206.                   last:=t^._low;
  5207.  
  5208.                   emitl(A_BEQ,t^.statement);
  5209.                end
  5210.              else
  5211.                begin
  5212.                   { it begins with the smallest label, if the value }
  5213.                   { is even smaller then jump immediately to the    }
  5214.                   { ELSE-label                                      }
  5215.                   if first then
  5216.                     begin
  5217.                        if (t^._low-1 > 0) and (t^._low < 9) then
  5218.  
  5219. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-1,hregister)))
  5220.                        else
  5221.                        if t^._low-1=0 then
  5222.  
  5223. exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
  5224.                        else
  5225.  
  5226. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-1,hregister)));
  5227.                        if t^._low = 0 then
  5228.                           emitl(A_BLE,elselabel)
  5229.                        else
  5230.                           emitl(jmp_lee,elselabel);
  5231.                     end
  5232.                   { if there is no unused label between the last and the }
  5233.                   { present label then the lower limit can be checked    }
  5234.                   { immediately. else check the range in between:        }
  5235.                   else if (t^._low-last>1)then
  5236.  
  5237.                     begin
  5238.                        if ((t^._low-last-1) > 0) and ((t^._low-last-1) < 9)
  5239. then
  5240.  
  5241. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last-1,hregister)))
  5242.                        else
  5243.  
  5244. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last-1,hregister)));
  5245.                        emitl(jmp_lee,elselabel);
  5246.                     end;
  5247.  
  5248. exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._high-t^._low+1,hregister)));
  5249.                   emitl(jmp_lee,t^.statement);
  5250.  
  5251.                   last:=t^._high;
  5252.                end;
  5253.              first:=false;
  5254.              if assigned(t^.greater) then
  5255.                genitem(t^.greater);
  5256.           end;
  5257.  
  5258.         var
  5259.            hr : tregister;
  5260.  
  5261.         begin
  5262.            { case register is modified by the list evalution }
  5263.            if (p^.left^.location.loc=LOC_CREGISTER) then
  5264.              begin
  5265.                 hr:=getregister32;
  5266.              end;
  5267.            last:=0;
  5268.            first:=true;
  5269.            genitem(hp);
  5270.            emitl(A_JMP,elselabel);
  5271.         end;
  5272.  
  5273.       procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
  5274.  
  5275.         var
  5276.            table : plabel;
  5277.            last : longint;
  5278.            hr : preference;
  5279.  
  5280.         procedure genitem(t : pcaserecord);
  5281.  
  5282.           var
  5283.              i : longint;
  5284.  
  5285.           begin
  5286.              if assigned(t^.less) then
  5287.                genitem(t^.less);
  5288.              { fill possible hole }
  5289.              for i:=last+1 to t^._low-1 do
  5290.                datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  5291.                  (elselabel)))));
  5292.              for i:=t^._low to t^._high do
  5293.                datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
  5294.                 (t^.statement)))));
  5295.               last:=t^._high;
  5296.              if assigned(t^.greater) then
  5297.                genitem(t^.greater);
  5298.           end;
  5299.  
  5300.         begin
  5301.            if not(jumptable_no_range) then
  5302.              begin
  5303.  
  5304. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,min_,hregister)));
  5305.                 { case expr less than min_ => goto elselabel }
  5306.                 emitl(jmp_le,elselabel);
  5307.  
  5308. exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,max_,hregister)));
  5309.                 emitl(jmp_gt,elselabel);
  5310.              end;
  5311.            getlabel(table);
  5312.            { extend with sign }
  5313.            if opsize=S_W then
  5314.              begin
  5315.                 { word to long - unsigned }
  5316.  
  5317. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
  5318.              end
  5319.            else if opsize=S_B then
  5320.              begin
  5321.                 { byte to long - unsigned }
  5322.  
  5323. exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
  5324.              end;
  5325.            new(hr);
  5326.            reset_reference(hr^);
  5327.            hr^.symbol:=stringdup(lab2str(table));
  5328.            hr^.offset:=(-min_)*4;
  5329.  
  5330.            { add scalefactor *4 to index }
  5331.  
  5332. exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,hregister)));
  5333. {           hr^.scalefactor:=4; }
  5334.            hr^.base:=getaddressreg;
  5335.            emit_reg_reg(A_MOVE,S_L,hregister,hr^.base);
  5336.            exprasmlist^.concat(new(pai68k,op_ref(A_JMP,S_NO,hr)));
  5337. {          if not(cs_littlesize in aktswitches^ ) then
  5338.              datasegment^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4))); }
  5339.            datasegment^.concat(new(pai_label,init(table)));
  5340.              last:=min_;
  5341.            genitem(hp);
  5342.            if hr^.base <> R_NO then ungetregister(hr^.base);
  5343.            { !!!!!!!
  5344.            if not(cs_littlesize in aktswitches^ ) then
  5345.              exprasmlist^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4)));
  5346.            }
  5347.         end;
  5348.  
  5349.       var
  5350.          lv,hv,min_label,max_label,labels : longint;
  5351.          max_linear_list : longint;
  5352.  
  5353.       begin
  5354.          getlabel(endlabel);
  5355.          getlabel(elselabel);
  5356.          with_sign:=is_signed(p^.left^.resulttype);
  5357.          if with_sign then
  5358.            begin
  5359.               jmp_gt:=A_BGT;
  5360.               jmp_le:=A_BLT;
  5361.               jmp_lee:=A_BLE;
  5362.            end
  5363.          else
  5364.            begin
  5365.               jmp_gt:=A_BHI;
  5366.               jmp_le:=A_BCS;
  5367.               jmp_lee:=A_BLS;
  5368.            end;
  5369.          cleartempgen;
  5370.          secondpass(p^.left);
  5371.          { determines the size of the operand }
  5372.          { determines the size of the operand }
  5373.          opsize:=bytes2Sxx[p^.left^.resulttype^.size];
  5374.          { copy the case expression to a register }
  5375.          { copy the case expression to a register }
  5376.          case p^.left^.location.loc of
  5377.             LOC_REGISTER,
  5378.             LOC_CREGISTER : hregister:=p^.left^.location.register;
  5379.             LOC_MEM,LOC_REFERENCE : begin
  5380.  
  5381. del_reference(p^.left^.location.reference);
  5382.                                            hregister:=getregister32;
  5383.  
  5384. exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
  5385.  
  5386. p^.left^.location.reference),hregister)));
  5387.                                     end;
  5388.             else internalerror(2002);
  5389.          end;
  5390.          { now generate the jumps }
  5391.          if cs_optimize in aktswitches  then
  5392.            begin
  5393.               { procedures are empirically passed on }
  5394.               { consumption can also be calculated   }
  5395.               { but does it pay on the different     }
  5396.               { processors?                          }
  5397.               { moreover can the size only be appro- }
  5398.               { ximated as it is not known if rel8,  }
  5399.               { rel16 or rel32 jumps are used        }
  5400.               min_label:=case_get_min(p^.nodes);
  5401.               max_label:=case_get_max(p^.nodes);
  5402.               labels:=case_count_labels(p^.nodes);
  5403.               { can we omit the range check of the jump table }
  5404.               getrange(p^.left^.resulttype,lv,hv);
  5405.               jumptable_no_range:=(lv=min_label) and (hv=max_label);
  5406.  
  5407.               { optimize for size ? }
  5408.               if cs_littlesize in aktswitches  then
  5409.                 begin
  5410.                    if (labels<=2) or ((max_label-min_label)>3*labels) then
  5411.                      { a linear list is always smaller than a jump tree }
  5412.                      genlinearlist(p^.nodes)
  5413.                    else
  5414.                      { if the labels less or more a continuum then }
  5415.                      genjumptable(p^.nodes,min_label,max_label);
  5416.                 end
  5417.               else
  5418.                 begin
  5419.                    if jumptable_no_range then
  5420.                      max_linear_list:=4
  5421.                    else
  5422.                      max_linear_list:=2;
  5423.  
  5424.                    if (labels<=max_linear_list) then
  5425.                      genlinearlist(p^.nodes)
  5426.                    else
  5427.                      begin
  5428.                         if ((max_label-min_label)>4*labels) then
  5429.                           begin
  5430.                              if labels>16 then
  5431.                                gentreejmp(p^.nodes)
  5432.                              else
  5433.                                genlinearlist(p^.nodes);
  5434.                           end
  5435.                         else
  5436.                           genjumptable(p^.nodes,min_label,max_label);
  5437.                      end;
  5438.                 end;
  5439.            end
  5440.          else
  5441.            { it's always not bad }
  5442.            genlinearlist(p^.nodes);
  5443.  
  5444.          { now generate the instructions }
  5445.          hp:=p^.right;
  5446.          while assigned(hp) do
  5447.            begin
  5448.               cleartempgen;
  5449.               secondpass(hp^.right);
  5450.               emitl(A_JMP,endlabel);
  5451.               hp:=hp^.left;
  5452.            end;
  5453.          emitl(A_LABEL,elselabel);
  5454.          { ... and the else block }
  5455.          if assigned(p^.elseblock) then
  5456.            begin
  5457.               cleartempgen;
  5458.               secondpass(p^.elseblock);
  5459.            end;
  5460.          emitl(A_LABEL,endlabel);
  5461.       end;
  5462.  
  5463.     procedure secondtryexcept(var p : ptree);
  5464.  
  5465.       begin
  5466.  
  5467.       end;
  5468.  
  5469.     procedure secondtryfinally(var p : ptree);
  5470.  
  5471.       begin
  5472.       end;
  5473.  
  5474.     procedure secondfail(var p : ptree);
  5475.  
  5476.       var hp : preference;
  5477.  
  5478.       begin
  5479.          {if procinfo.exceptions then
  5480.            aktproccode.concat(gennasmrec(CALL,S_NO,'HELP_DESTRUCTOR_E'))
  5481.          else }
  5482.          { we should know if the constructor is called with a new or not,
  5483.          how can we do that ???
  5484.  
  5485. exprasmlist^.concat(new(pai68k,op_csymbol(A_CALL,S_NO,newcsymbol('HELP_DESTRUCTOR',0))));
  5486.          }
  5487.          exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_A5)));
  5488.          { also reset to zero in the stack }
  5489.          new(hp);
  5490.          reset_reference(hp^);
  5491.          hp^.offset:=procinfo.ESI_offset;
  5492.          hp^.base:=procinfo.framepointer;
  5493.          exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A5,hp)));
  5494.          exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
  5495.       end;
  5496.  
  5497.     procedure secondas(var p : ptree);
  5498.  
  5499.       var
  5500.          pushed : tpushed;
  5501.  
  5502.       begin
  5503.          set_location(p^.location,p^.left^.location);
  5504.          { save all used registers }
  5505.          pushusedregisters(pushed,$ffff);
  5506.          { push the vmt of the class }
  5507.          exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
  5508.  
  5509. S_L,newcsymbol(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,0),R_SPPUSH)));
  5510.  
  5511. concat_external(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,EXT_NEAR);
  5512.          emitpushreferenceaddr(p^.location.reference);
  5513.           emitcall('DO_AS',true);
  5514.          popusedregisters(pushed);
  5515.       end;
  5516.  
  5517.     procedure secondis(var p : ptree);
  5518.  
  5519.       var
  5520.          pushed : tpushed;
  5521.  
  5522.       begin
  5523.          { save all used registers }
  5524.          pushusedregisters(pushed,$ffff);
  5525.          secondpass(p^.left);
  5526.          p^.location.loc:=LOC_FLAGS;
  5527.          p^.location.resflags:=F_NE;
  5528.  
  5529.          { push instance to check: }
  5530.          case p^.left^.location.loc of
  5531.             LOC_REGISTER,LOC_CREGISTER:
  5532.               begin
  5533.                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
  5534.                    S_L,p^.left^.location.register,R_SPPUSH)));
  5535.                  ungetregister32(p^.left^.location.register);
  5536.               end;
  5537.             LOC_MEM,LOC_REFERENCE:
  5538.               begin
  5539.                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
  5540.  
  5541. S_L,newreference(p^.left^.location.reference),R_SPPUSH)));
  5542.                  del_reference(p^.left^.location.reference);
  5543.               end;
  5544.             else internalerror(100);
  5545.          end;
  5546.  
  5547.          { generate type checking }
  5548.          secondpass(p^.right);
  5549.          case p^.right^.location.loc of
  5550.             LOC_REGISTER,LOC_CREGISTER:
  5551.               begin
  5552.                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
  5553.                    S_L,p^.right^.location.register,R_SPPUSH)));
  5554.                  ungetregister32(p^.right^.location.register);
  5555.               end;
  5556.             LOC_MEM,LOC_REFERENCE:
  5557.               begin
  5558.                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
  5559.  
  5560. S_L,newreference(p^.right^.location.reference),R_SPPUSH)));
  5561.                  del_reference(p^.right^.location.reference);
  5562.               end;
  5563.             else internalerror(100);
  5564.          end;
  5565.          emitcall('DO_IS',true);
  5566.          exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
  5567.          popusedregisters(pushed);
  5568.       end;
  5569.  
  5570.     procedure secondwith(var p : ptree);
  5571.  
  5572.        var
  5573.           ref : treference;
  5574.           symtable : psymtable;
  5575.           i : longint;
  5576.  
  5577.        begin
  5578.           if assigned(p^.left) then
  5579.             begin
  5580.                secondpass(p^.left);
  5581.                ref.symbol:=nil;
  5582.                gettempofsizereference(4,ref);
  5583.                exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
  5584.                  newreference(p^.left^.location.reference),R_A0)));
  5585.                exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
  5586.                  R_A0,newreference(ref))));
  5587.                del_reference(p^.left^.location.reference);
  5588.                { the offset relative to (%ebp) is only needed here! }
  5589.                symtable:=p^.withsymtable;
  5590.                for i:=1 to p^.tablecount do
  5591.                  begin
  5592.                     symtable^.datasize:=ref.offset;
  5593.                     symtable:=symtable^.next;
  5594.                  end;
  5595.  
  5596.                { p^.right can be optimize out !!! }
  5597.                if p^.right<>nil then
  5598.                  secondpass(p^.right);
  5599.                { clear some stuff }
  5600.                ungetiftemp(ref);
  5601.             end;
  5602.        end;
  5603.  
  5604.     procedure secondpass(var p : ptree);
  5605.       const
  5606.            procedures : array[ttreetyp] of secondpassproc =
  5607.                (secondadd,secondadd,secondadd,secondmoddiv,secondadd,
  5608.                 secondmoddiv,secondassignment,secondload,secondnothing,
  5609.                 secondadd,secondadd,secondadd,secondadd,
  5610.                 secondadd,secondadd,secondin,secondadd,
  5611.                 secondadd,secondshlshr,secondshlshr,secondadd,
  5612.                secondadd,secondsubscriptn,secondderef,secondaddr,
  5613.              seconddoubleaddr,
  5614.              secondordconst,secondtypeconv,secondcalln,secondnothing,
  5615.              secondrealconst,secondfixconst,secondumminus,
  5616.              secondasm,secondvecn,
  5617.              secondstringconst,secondfuncret,secondselfn,
  5618.              secondnot,secondinline,secondniln,seconderror,
  5619.              secondnothing,secondhnewn,secondhdisposen,secondnewn,
  5620.  
  5621. secondsimplenewdispose,secondnothing,secondsetcons,secondblockn,
  5622.              secondnothing,secondnothing,secondifn,secondbreakn,
  5623.  
  5624. secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
  5625.              secondexitn,secondwith,secondcase,secondlabel,
  5626.              secondgoto,secondsimplenewdispose,secondtryexcept,secondraise,
  5627.              secondnothing,secondtryfinally,secondis,secondas,seconderror,
  5628.              secondfail,
  5629.              secondnothing,secondloadvmt);
  5630.       var
  5631.          oldcodegenerror : boolean;
  5632.          oldswitches : Tcswitches;
  5633.          oldis : pinputfile;
  5634.          oldnr : longint;
  5635.  
  5636.       begin
  5637.          oldcodegenerror:=codegenerror;
  5638.          oldswitches:=aktswitches;
  5639.          oldis:=current_module^.current_inputfile;
  5640.          oldnr:=current_module^.current_inputfile^.line_no;
  5641.  
  5642.          codegenerror:=false;
  5643.          current_module^.current_inputfile:=p^.inputfile;
  5644.          current_module^.current_inputfile^.line_no:=p^.line;
  5645.          aktswitches:=p^.pragmas;
  5646.          if not(p^.error) then
  5647.            begin
  5648.               procedures[p^.treetype](p);
  5649.               p^.error:=codegenerror;
  5650.               codegenerror:=codegenerror or oldcodegenerror;
  5651.            end
  5652.          else codegenerror:=true;
  5653.          aktswitches:=oldswitches;
  5654.          current_module^.current_inputfile:=oldis;
  5655.          current_module^.current_inputfile^.line_no:=oldnr;
  5656.       end;
  5657.  
  5658.     function do_secondpass(var p : ptree) : boolean;
  5659.  
  5660.       begin
  5661.          codegenerror:=false;
  5662.          if not(p^.error) then
  5663.            secondpass(p);
  5664.          do_secondpass:=codegenerror;
  5665.       end;
  5666.  
  5667.     var
  5668.        regvars : array[1..maxvarregs] of pvarsym;
  5669.        regvars_para : array[1..maxvarregs] of boolean;
  5670.        regvars_refs : array[1..maxvarregs] of longint;
  5671.        parasym : boolean;
  5672.  
  5673.     procedure searchregvars(p : psym);
  5674.  
  5675.       var
  5676.          i,j,k : longint;
  5677.  
  5678.       begin
  5679.          if (p^.typ=varsym) and (pvarsym(p)^.regable) then
  5680.            begin
  5681.               { walk through all momentary register variables }
  5682.               for i:=1 to maxvarregs do
  5683.                 begin
  5684.                    { free register ? }
  5685.                    if regvars[i]=nil then
  5686.                      begin
  5687.                         regvars[i]:=pvarsym(p);
  5688.                         regvars_para[i]:=parasym;
  5689.                         break;
  5690.                      end;
  5691.                    { else throw out a variable ? }
  5692.                    j:=pvarsym(p)^.refs;
  5693.                    { parameter get a less value }
  5694.                    if parasym then
  5695.                      begin
  5696.                         if cs_littlesize in aktswitches  then
  5697.                           dec(j,1)
  5698.                         else
  5699.                           dec(j,100);
  5700.                      end;
  5701.                    if (j>regvars_refs[i]) and (j>0) then
  5702.                      begin
  5703.                         for k:=maxvarregs-1 downto i do
  5704.                           begin
  5705.                              regvars[k+1]:=regvars[k];
  5706.                              regvars_para[k+1]:=regvars_para[k];
  5707.                           end;
  5708.                         { calc the new refs
  5709.                         pvarsym(p)^.refs:=j; }
  5710.                         regvars[i]:=pvarsym(p);
  5711.                         regvars_para[i]:=parasym;
  5712.                         regvars_refs[i]:=j;
  5713.                         break;
  5714.                      end;
  5715.                 end;
  5716.            end;
  5717.       end;
  5718.  
  5719.     procedure generatecode(var p : ptree);
  5720.  
  5721.       var
  5722.          { *pass modifies with every node aktlinenr and
  5723. current_module^.current_inputfile, }
  5724.          { to constantly contain the right line numbers             }
  5725.          oldis : pinputfile;
  5726.          oldnr,i : longint;
  5727.          regsize : topsize;
  5728.          regi : tregister;
  5729.          hr : preference;
  5730.  
  5731.       label
  5732.          nextreg;
  5733.  
  5734.       begin
  5735.          cleartempgen;
  5736.          oldis:=current_module^.current_inputfile;
  5737.          oldnr:=current_module^.current_inputfile^.line_no;
  5738.          { when size optimization only count occurrence }
  5739.          if cs_littlesize in aktswitches then
  5740.            t_times:=1
  5741.          else
  5742.          { reference for repetition is 100 }
  5743.            t_times:=100;
  5744.          { clear register count }
  5745.          for regi:=R_D0 to R_A6 do
  5746.            begin
  5747.               reg_pushes[regi]:=0;
  5748.               is_reg_var[regi]:=false;
  5749.            end;
  5750.  
  5751.          use_esp_stackframe:=false;
  5752.  
  5753.          if not(do_firstpass(p)) then
  5754.            begin
  5755.               { max. optimizations     }
  5756.               { only if no asm is used }
  5757.               if (cs_maxoptimieren in aktswitches) and
  5758.                 ((procinfo.flags and pi_uses_asm)=0) then
  5759.                 begin
  5760.                    { can we omit the stack frame ? }
  5761.                    { conditions:
  5762.                      1. procedure (not main block)
  5763.                      2. no constructor or destructor
  5764.                      3. no call to other procedures
  5765.                      4. no interrupt handler
  5766.                    }
  5767.                    if assigned(aktprocsym) then
  5768.                      begin
  5769.                       if (aktprocsym^.definition^.options and
  5770. poconstructor+podestructor+poinline+pointerrupt=0) and
  5771.                        ((procinfo.flags and pi_do_call)=0) and (lexlevel>1)
  5772. then
  5773.                        begin
  5774.                           { use ESP as frame pointer }
  5775.                           procinfo.framepointer:=R_SP;
  5776.                           use_esp_stackframe:=true;
  5777.  
  5778.                           { calc parameter distance new }
  5779.                           dec(procinfo.framepointer_offset,4);
  5780.                           dec(procinfo.ESI_offset,4);
  5781.  
  5782.                           dec(procinfo.retoffset,4);
  5783.  
  5784.                           dec(procinfo.call_offset,4);
  5785.  
  5786. aktprocsym^.definition^.parast^.call_offset:=procinfo.call_offset;
  5787.                        end;
  5788.                           end; { endif assigned }
  5789.                    if (p^.registers32<4) then
  5790.                      begin
  5791.                         for i:=1 to maxvarregs do
  5792.                           regvars[i]:=nil;
  5793.                         parasym:=false;
  5794. {$ifdef tp}
  5795.                         symtablestack^.foreach(searchregvars);
  5796. {$else}
  5797.                         symtablestack^.foreach(@searchregvars);
  5798. {$endif}
  5799.                         { copy parameter into a register ? }
  5800.                         parasym:=true;
  5801. {$ifdef tp}
  5802.                         symtablestack^.next^.foreach(searchregvars);
  5803. {$else}
  5804.                         symtablestack^.next^.foreach(@searchregvars);
  5805. {$endif}
  5806.  
  5807.                         { hold needed registers free }
  5808.                         for i:=maxvarregs downto maxvarregs-p^.registers32+1
  5809. do
  5810.                           regvars[i]:=nil;
  5811.                         { now assign register }
  5812.                         for i:=1 to maxvarregs do
  5813.                           begin
  5814.                              if assigned(regvars[i]) then
  5815.                                begin
  5816.                                   { it is nonsens, to copy the variable to }
  5817.                                   { a register because we need then much   }
  5818.                                   { pushes ?                               }
  5819.                                   if
  5820. reg_pushes[varregs[i]]>=regvars[i]^.refs then
  5821.                                     begin
  5822.                                        regvars[i]:=nil;
  5823.                                        goto nextreg;
  5824.                                     end;
  5825.  
  5826.                                   { register is no longer available for }
  5827.                                   { expressions                         }
  5828.                                   { search the register which is the most }
  5829.                                   { unused                                }
  5830.                                   usableregs:=usableregs-[varregs[i]];
  5831.                                   is_reg_var[varregs[i]]:=true;
  5832.                                   dec(c_usableregs);
  5833.  
  5834.                                   { possibly no 32 bit register are needed }
  5835.                                   if
  5836. (regvars[i]^.definition^.deftype=orddef) and
  5837.                                       (
  5838.  
  5839. (porddef(regvars[i]^.definition)^.typ=bool8bit) or
  5840.  
  5841. (porddef(regvars[i]^.definition)^.typ=uchar) or
  5842.  
  5843. (porddef(regvars[i]^.definition)^.typ=u8bit) or
  5844.  
  5845. (porddef(regvars[i]^.definition)^.typ=s8bit)
  5846.                                       ) then
  5847.                                     begin
  5848.                                        regvars[i]^.reg:=varregs[i];
  5849.                                        regsize:=S_B;
  5850.                                     end
  5851.                                   else if
  5852. (regvars[i]^.definition^.deftype=orddef) and
  5853.                                       (
  5854.  
  5855. (porddef(regvars[i]^.definition)^.typ=u16bit) or
  5856.  
  5857. (porddef(regvars[i]^.definition)^.typ=s16bit)
  5858.                                       ) then
  5859.                                     begin
  5860.                                        regvars[i]^.reg:=varregs[i];
  5861.                                        regsize:=S_W;
  5862.                                     end
  5863.                                   else
  5864.                                     begin
  5865.                                        regvars[i]^.reg:=varregs[i];
  5866.                                        regsize:=S_L;
  5867.                                     end;
  5868.                                   { parameter must be load }
  5869.                                   if regvars_para[i] then
  5870.                                     begin
  5871.                                        { procinfo is there actual,      }
  5872.                                        { because we can't never be in a }
  5873.                                        { nested procedure               }
  5874.                                        { when loading parameter to reg  }
  5875.                                        new(hr);
  5876.                                        reset_reference(hr^);
  5877.  
  5878. hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  5879.                                        hr^.base:=procinfo.framepointer;
  5880.  
  5881. procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
  5882.                                          hr,regvars[i]^.reg)));
  5883.                                        unused:=unused - [regvars[i]^.reg];
  5884.                                     end;
  5885.                                   { procedure uses this register }
  5886.                                   usedinproc:=usedinproc or ($800 shr
  5887. word(varregs[i]));
  5888.                                end;
  5889.                              nextreg:
  5890.                                { dummy }
  5891.                                regsize:=S_W;
  5892.                           end;
  5893.                         if (verbosity and v_debug)=v_debug then
  5894.                           begin
  5895.                              for i:=1 to maxvarregs do
  5896.                                begin
  5897.                                   if assigned(regvars[i]) then
  5898.  
  5899. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  5900.  
  5901. tostr(regvars[i]^.refs),regvars[i]^.name);
  5902.                                end;
  5903.                           end;
  5904.                      end;
  5905.                 end;
  5906.               do_secondpass(p);
  5907.  
  5908.               { all registers can be used again }
  5909.               { contains both information on Address registers and data
  5910. registers }
  5911.               { even if they are allocated separately.
  5912. }
  5913.  
  5914. usableregs:=[R_D0,R_D1,R_D2,R_D3,R_D4,R_D5,R_D6,R_D7,R_A0,R_A1,R_A2,R_A3,R_A4,
  5915.                   R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,R_FP7];
  5916.               c_usableregs:=4;
  5917.               usableaddress:=3;
  5918.            end;
  5919.          procinfo.aktproccode^.concatlist(exprasmlist);
  5920.  
  5921.          current_module^.current_inputfile:=oldis;
  5922.          current_module^.current_inputfile^.line_no:=oldnr;
  5923.       end;
  5924.  
  5925. end.
  5926.  
  5927. {
  5928.   $Log: cg68k.pas,v $
  5929.   Revision 1.2.2.9  1998/09/21 19:06:21  carl
  5930.     * bugfix with return value as word - was returning a long
  5931.  
  5932.   Revision 1.2.2.8  1998/09/14 18:54:48  carl
  5933.     * set alignment
  5934.  
  5935.   Revision 1.2.2.7  1998/08/13 17:41:19  florian
  5936.     + some stuff for the PalmOS added
  5937.  
  5938.   Revision 1.2.2.6  1998/08/13 13:30:44  carl
  5939.     * second_smaller bugfix with enums (must be loaded into reg!)
  5940.  
  5941.   Revision 1.2.2.5  1998/07/29 12:26:34  carl
  5942.     * TypeOf bugfix, we need to use address reg and LEA instead of move
  5943.     * LOC_FLAGS and LOC_JUMP were pushing words, LSL hack used now
  5944.  
  5945.   Revision 1.2.2.4  1998/07/21 12:12:55  carl
  5946.     * secondassignment, we must check the usableadress not usablereg32,
  5947.   because we will be loading into an address register!
  5948.  
  5949.   Revision 1.2  1998/03/28 23:09:54  florian
  5950.     * secondin bugfix (m68k and i386)
  5951.     * overflow checking bugfix (m68k and i386) -- pretty useless in
  5952.       secondadd, since everything is done using 32-bit
  5953.     * loading pointer to routines hopefully fixed (m68k)
  5954.     * flags problem with calls to RTL internal routines fixed (still strcmp
  5955.       to fix) (m68k)
  5956.     * #ELSE was still incorrect (didn't take care of the previous level)
  5957.     * problem with filenames in the command line solved
  5958.     * problem with mangledname solved
  5959.     * linking name problem solved (was case insensitive)
  5960.     * double id problem and potential crash solved
  5961.     * stop after first error
  5962.     * and=>test problem removed
  5963.     * correct read for all float types
  5964.     * 2 sigsegv fixes and a cosmetic fix for Internal Error
  5965.     * push/pop is now correct optimized (=> mov (%esp),reg)
  5966.  
  5967.   Revision 1.1.1.1  1998/03/25 11:18:16  root
  5968.   * Restored version
  5969.  
  5970.   Revision 1.51  1998/03/22 12:45:37  florian
  5971.     * changes of Carl-Eric to m68k target commit:
  5972.       - wrong nodes because of the new string cg in intel, I had to create
  5973.         this under m68k also ... had to work it out to fix potential
  5974. alignment
  5975.         problems --> this removes the crash of the m68k compiler.
  5976.       - added absolute addressing in m68k assembler (required for Amiga
  5977. startup)
  5978.       - fixed alignment problems (because of byte return values, alignment
  5979.         would not be always valid) -- is this ok if i change the offset if
  5980. odd in
  5981.         setfirsttemp ?? -- it seems ok...
  5982.  
  5983.   Revision 1.50  2036/02/07 09:29:32  florian
  5984.     * patch of Carl applied
  5985.  
  5986.   Revision 1.49  1998/03/10 16:27:36  pierre
  5987.     * better line info in stabs debug
  5988.     * symtabletype and lexlevel separated into two fields of tsymtable
  5989.     + ifdef MAKELIB for direct library output, not complete
  5990.     + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  5991.       working
  5992.     + ifdef TESTFUNCRET for setting func result in underfunction, not
  5993.       working
  5994.  
  5995.   Revision 1.48  1998/03/10 15:25:31  carl
  5996.     + put back $L switch for debugging
  5997.  
  5998.   Revision 1.47  1998/03/10 04:19:24  carl
  5999.     - removed string:=char optimization because would give A LOT of
  6000.   register problems
  6001.  
  6002.   Revision 1.46  1998/03/10 01:17:15  peter
  6003.     * all files have the same header
  6004.     * messages are fully implemented, EXTDEBUG uses Comment()
  6005.     + AG... files for the Assembler generation
  6006.  
  6007.   Revision 1.45  1998/03/09 10:44:33  peter
  6008.     + string='', string<>'', string:='', string:=char optimizes (the first 2
  6009.       were already in cg68k2)
  6010.  
  6011.   Revision 1.44  1998/03/06 00:51:57  peter
  6012.     * replaced all old messages from errore.msg, only ExtDebug and some
  6013.       Comment() calls are left
  6014.     * fixed options.pas
  6015.  
  6016.   Revision 1.43  1998/03/05 04:37:46  carl
  6017.     + small optimization
  6018.  
  6019.   Revision 1.42  1998/03/03 04:13:31  carl
  6020.     - removed generate_xxxx and put them in cga68k
  6021.  
  6022.   Revision 1.41  1998/03/03 01:08:17  florian
  6023.     * bug0105 and bug0106 problem solved
  6024.  
  6025.   Revision 1.40  1998/03/02 16:25:25  carl
  6026.     * bugfix #95
  6027.  
  6028.   Revision 1.39  1998/03/02 01:48:11  peter
  6029.     * renamed target_DOS to target_GO32V1
  6030.     + new verbose system, merged old errors and verbose units into one new
  6031.       verbose.pas, so errors.pas is obsolete
  6032.  
  6033.   Revision 1.38  1998/02/25 02:36:29  carl
  6034.     * small bugfix with range checking
  6035.  
  6036.   Revision 1.37  1998/02/24 16:49:48  peter
  6037.     * stackframe ommiting generated 'ret $-4'
  6038.     + timer.pp bp7 version
  6039.     * innr.inc are now the same files
  6040.  
  6041.   Revision 1.36  1998/02/24 16:42:49  carl
  6042.     + reinstated __EXIT
  6043.  
  6044.   Revision 1.35  1998/02/23 02:56:38  carl
  6045.     * bugfix of writing real type values qith m68k target
  6046.  
  6047.   Revision 1.34  1998/02/22 23:03:05  peter
  6048.     * renamed msource->mainsource and name->unitname
  6049.     * optimized filename handling, filename is not seperate anymore with
  6050.       path+name+ext, this saves stackspace and a lot of fsplit()'s
  6051.     * recompiling of some units in libraries fixed
  6052.     * shared libraries are working again
  6053.     + $LINKLIB <lib> to support automatic linking to libraries
  6054.     + libraries are saved/read from the ppufile, also allows more libraries
  6055.       per ppufile
  6056.  
  6057.   Revision 1.33  1998/02/22 18:50:12  carl
  6058.     * bugfix of stupid diffs!!!!! Recursive crash fix!
  6059.  
  6060.   Revision 1.30  1998/02/19 12:22:29  daniel
  6061.   * Optimized a statement that did pain to my eyes.
  6062.  
  6063.   Revision 1.29  1998/02/17 21:20:31  peter
  6064.     + Script unit
  6065.     + __EXIT is called again to exit a program
  6066.     - target_info.link/assembler calls
  6067.     * linking works again for dos
  6068.     * optimized a few filehandling functions
  6069.     * fixed stabs generation for procedures
  6070.  
  6071.   Revision 1.28  1998/02/15 21:16:04  peter
  6072.     * all assembler outputs supported by assemblerobject
  6073.     * cleanup with assembleroutputs, better .ascii generation
  6074.     * help_constructor/destructor are now added to the externals
  6075.     - generation of asmresponse is not outputformat depended
  6076.  
  6077.   Revision 1.27  1998/02/14 05:06:47  carl
  6078.     + now works with TP with overlays
  6079.  
  6080.   Revision 1.26  1998/02/14 01:45:06  peter
  6081.     * more fixes
  6082.     - pmode target is removed
  6083.     - search_as_ld is removed, this is done in the link.pas/assemble.pas
  6084.     + findexe() to search for an executable (linker,assembler,binder)
  6085.  
  6086.   Revision 1.25  1998/02/13 10:34:40  daniel
  6087.   * Made Motorola version compilable.
  6088.   * Fixed optimizer
  6089.  
  6090.   Revision 1.24  1998/02/12 11:49:45  daniel
  6091.   Yes! Finally! After three retries, my patch!
  6092.  
  6093.   Changes:
  6094.  
  6095.   Complete rewrite of psub.pas.
  6096.   Added support for DLL's.
  6097.   Compiler requires less memory.
  6098.   Platform units for each platform.
  6099.  
  6100.   Revision 1.23  1998/02/07 18:00:45  carl
  6101.     * bugfix in secondin (from Peter Vreman a while ago)
  6102.  
  6103.   Revision 1.21  1998/02/05 00:58:05  carl
  6104.     + secondas and secondis now work as expected.
  6105.     - moved secondas to cg68k2, otherwise problems with symbols
  6106.  
  6107.   Revision 1.20  1998/02/01 19:38:41  florian
  6108.     * bug0029 fixed, Carl please check it !!!
  6109.  
  6110.   Revision 1.19  1998/01/24 21:05:41  carl
  6111.     * nested comment bugfix
  6112.  
  6113.   Revision 1.18  1998/01/24 00:37:47  florian
  6114.     * small fix for DOM
  6115.  
  6116.   Revision 1.17  1998/01/21 21:29:46  florian
  6117.     * some fixes for Delphi classes
  6118.  
  6119.   Revision 1.16  1998/01/20 23:51:59  carl
  6120.     * bugfix 74 (FINAL, Pierre's one was incomplete under BP)
  6121.  
  6122.   Revision 1.15  1998/01/19 10:25:21  pierre
  6123.     * bug in object function call in main program or unit init fixed
  6124.  
  6125.   Revision 1.14  1998/01/16 22:34:23  michael
  6126.   * Changed 'conversation' to 'conversion'. Waayyy too much chatting going
  6127. on
  6128.     in this compiler :)
  6129.  
  6130.   Revision 1.13  1998/01/16 02:18:25  carl
  6131.     * second_char_to_string align problem fix (N/A for MC68020 target)
  6132.  
  6133.   Revision 1.12  1998/01/13 23:11:02  florian
  6134.     + class methods
  6135.  
  6136.   Revision 1.11  1998/01/11 03:36:14  carl
  6137.   * fixed indexing problem with stack
  6138.   * reference on stack bugfix
  6139.   * second_bigger sign extension bugfix
  6140.   * array scaling bugfix
  6141.   * secondderef bugfix
  6142.   * bugfix with MOVEQ opcode
  6143.   * bugfix of linear list generation
  6144.  
  6145.   Revision 1.6  1997/12/10 23:07:12  florian
  6146.   * bugs fixed: 12,38 (also m68k),39,40,41
  6147.   + warning if a system unit is without -Us compiled
  6148.   + warning if a method is virtual and private (was an error)
  6149.   * some indentions changed
  6150.   + factor does a better error recovering (omit some crashes)
  6151.   + problem with @type(x) removed (crashed the compiler)
  6152.  
  6153.   Revision 1.5  1997/12/09 13:28:48  carl
  6154.   + added s80 real (will presently stop the compiler though)
  6155.   + renamed some stuff
  6156.   * some bugfixes (can't remember what exactly..)
  6157.  
  6158.   Revision 1.4  1997/12/05 14:51:09  carl
  6159.   * bugfix of secondfor
  6160.       cmpreg was never initialized.
  6161.       one of the jump conditionals was wrong (downto would not work)
  6162.  
  6163.   Revision 1.3  1997/12/04 14:47:05  carl
  6164.   + updated tov09...
  6165.  
  6166.   Revision 1.2  1997/11/28 18:14:20  pierre
  6167.    working version with several bug fixes
  6168.  
  6169.   Revision 1.1.1.1  1997/11/27 08:32:51  michael
  6170.   FPC Compiler CVS start
  6171.  
  6172.   Pre-CVS log:
  6173.  
  6174.   CEC   Carl-Eric Codere
  6175.   FK     Florian Klaempfl
  6176.   PM    Pierre Muller
  6177.   +      feature added
  6178.   -      removed
  6179.   *      bug fixed or changed
  6180.  
  6181.   History (started with version 0.9.0):
  6182.       23th october 1996:
  6183.          + some emit calls replaced (FK)
  6184.       24th october 1996:
  6185.          * for bug fixed (FK)
  6186.       26th october 1996:
  6187.          * english comments (FK)
  6188.        5th november 1996:
  6189.          * new init and terminate code (FK)
  6190.  
  6191.       ...... some items missed
  6192.  
  6193.       19th september 1997:
  6194.          * a call to a function procedure a;[ C ]; doesn't crash the stack
  6195.            furthermore (FK)
  6196.       22th september 1997:
  6197.          * stack layout for nested procedures in methods modified:
  6198.            ESI is no more pushed (must be loaded via framepointer) (FK)
  6199.  
  6200.       27th september 1997:
  6201.         + Start of conversion to motorola MC68000 (CEC)
  6202.       29th september 1997:
  6203.         + Updated to version 0.9.4 of Intel code generator (CEC)
  6204.       3th october 1997:
  6205.         + function second_bool_to_byte for ord(boolean) (PM)
  6206.       4th october 1997: (CEC)
  6207.          + first compilation
  6208.       5th octover 1997:
  6209.           check floating point negate when i can test everything,
  6210.             to see if it makes any sense , according SINGLE_NEG from
  6211.             sozobon, it does not.??
  6212.       8th october 1997:
  6213.         + ord(x) support (FK)
  6214.         + some stuff for typed file support (FK)
  6215.       9 october 1997:
  6216.         + converted code to motorola for v096 (CEC)
  6217.      18 october 1997:
  6218.         +* removed bugs relating to floating point condition codes. (CEC).
  6219.            (in secondadd).
  6220.         + had to put secondadd in another routine to compile in tp. (CEC).
  6221.         + updated second_bool_to_byte,secondtypeconv and secondinline,
  6222. secondvecn to v097 (CEC)
  6223.         + updated secondload and secondstringconst (merging duplicate
  6224. strings),secondfor to v95/v97 (CEC).
  6225.         + finally converted second_fix_real (very difficult and untested!).
  6226. (CEC)
  6227.      23 october 1997:
  6228.         * bugfix of address register in usableregs set. (They were not
  6229. defined...) (CEC).
  6230.      24 october 1997:
  6231.         * bugfix of scalefactor, allowed unrolled using lsl. (CEC).
  6232.    27th october 1997:
  6233.        + now all general purpose registers are in the unused list, so this
  6234. fixes problems
  6235.          regarding pushing registers (such as d0) which were actually never
  6236. used. (CEC)
  6237.        + added secondin (FK) (all credit goes to him).
  6238.        + converted second_real_fix thanks to Daniel Mantione for the
  6239. information
  6240.          he gave me on the fixed format. Thanks to W. Metzenthen who did
  6241. WMEmu
  6242.          (which in turn gave me information on the control word of the intel
  6243. fpu). (CEC)
  6244.    23rd november 1997:
  6245.        + changed second_int_real to apply correct calling conventions of
  6246. rtl.
  6247.    26th november 1997:
  6248.        + changed secondmoddiv to apply correct calling conventions of rtl
  6249.           and also optimized it a bit.
  6250.  
  6251. }
  6252.